自定义博客皮肤VIP专享

*博客头图:

格式为PNG、JPG,宽度*高度大于1920*100像素,不超过2MB,主视觉建议放在右侧,请参照线上博客头图

请上传大于1920*100像素的图片!

博客底图:

图片格式为PNG、JPG,不超过1MB,可上下左右平铺至整个背景

栏目图:

图片格式为PNG、JPG,图片宽度*高度为300*38像素,不超过0.5MB

主标题颜色:

RGB颜色,例如:#AFAFAF

Hover:

RGB颜色,例如:#AFAFAF

副标题颜色:

RGB颜色,例如:#AFAFAF

自定义博客皮肤

-+

northwolves[狼行天下] 的专栏

无知无惧,无欲无敌。

  • 博客(229)
  • 收藏
  • 关注

原创 EXCEL 中 判断某个自定义序列是否存在

Sub Macro1()Dim customlist As String, i As Longcustomlist = "全部自定义序列" & vbCrLf & String(30, "-") & vbCrLfFor i = 1 To Application.CustomListCountcustomlist = customlist & "【" & Format(i, "00") & "】" &

2007-04-10 11:17:00 1486

原创 全硬盘高速查找指定文件

Private Declare Function SearchTreeForFile Lib "ImageHlp.dll" (ByVal lpRoot As String, ByVal lpInPath As String, ByVal lpOutPath As String) As LongPrivate Declare Function GetDriveType Lib "kernel32"

2007-04-10 11:03:00 3713

原创 VB中显示TIF(扫描文件)的方法

添加部件Library MODICtl C:/PROGRA~1/COMMON~1/MICROS~1/MODI/11.0/MDIVWCTL.oca Microsoft Office Document Imaging 11.0 Type LibraryPrivate Sub Command1_Click()MiDocView1.FileName = "c:/00

2007-04-08 15:05:00 2894

原创 WORD 文档中的艺术字

如何判断艺术字的样式,字体,字号?Sub macro1() Dim myShape As Shape, s(4) As String For Each myShape In ActiveDocument.Shapes If myShape.Type = msoTextEffect Then s(0) = "名称:" & myShape.Name

2007-04-08 15:01:00 1968

原创 获取EXE文件安装后的路径

WINRAR安装路径Sub GetWINRARPath()Dim WSH As ObjectSet WSH = CreateObject("Wscript.Shell")MsgBox "WINRAR安装路径:" & WSH.RegRead("HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion/App Paths

2007-04-08 14:58:00 1411

原创 最小公倍数

“辗转相除法”求解最小公倍数Function LCM(ParamArray nums()) As LongDim temp1 As Long, temp2 As Long, I As LongLCM = nums(0)For I = 1 To UBound(nums)temp1 = LCMtemp2 = nums(I)LCM = LCM * temp2Do

2007-04-08 14:52:00 811

原创 按行获取文本文件的内容

不知是不是VB里最简单的方法?Sub getlines(byval filename as string,byref lines() as string)If Len(Dir(filename)) = 0 Then Exit SubOpen filename For Input As #1 打开文件。lines = Split(StrConv(InputB(LOF(1

2007-04-08 14:47:00 925

原创 获取光盘序列号

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongSub main()Dim driveinfo As String, i As ByteFor i = 0 To 25driveinfo = Chr(i + 65) & ":"If

2007-02-01 11:11:00 1637

原创 小数的循环节

 输入N/D的形式,其中N为分子,D为分母。  如得出的结果小数部分存在循环,就用括号括起来 ,如1/3=0.(3);22/5=4.4 ;1/7=(142857)Function xunhuan(ByVal N As Long, ByVal D As Long) As String 请依次输入N/D得形式,其中N为分子,D为分母If N Mod D = 0 Then 整除xunhuan

2007-01-17 01:03:00 1224

原创 常见的统计术语翻译(转帖)

Absolute deviation, 绝对离差Absolute number, 绝对数Absolute residuals, 绝对残差Acceleration array, 加速

2006-12-24 01:36:00 5778

转载 听力资料

Focus Listening 1http://edu.qd.sd.cn/audition/college/1/lesson1.mp3http://edu.qd.sd.cn/aud

2006-12-24 01:19:00 1125

原创 我在CSDN参与的3000个帖子

 今日偶然翻到,感慨万千 1:申述:版主,是否扣了我的专家分? 2:100分急求,随机输出十个小写字母,但是,要求这十个字母不相同 3:求Sn=a+aa+aaa+…+aaa…a(n个a)之值 4:数组题 望高手帮忙! 5:呵呵,来推荐一下我的网站,本站提供大量当今流行的免费的音乐和免费电影,常用软件、游戏、精美图库下载,希望对网友有帮助!顺便散分! 6:VBA请教怎

2006-11-17 16:42:00 55862 12

原创 多元一次方程组的求解

求解多元一次方程组:f(1,1)x1+f(1,2)x2+f(1,3)x3+...=f(1,n)f(2,1)x1+f(2,2)x2+f(2,3)x3+...=f(2,n)f(3,1)x1+f(3,2)x2+f(3,3)x3+...=f(3,n)......f(m,1)x1+f(m,2)x2+f(m,3)x3+...=f(m,n)采用高斯消元法:Option Base 1 

2006-11-03 20:00:00 6531

原创 VBA按区导出电脑字库区位码

 Its easy: Sub getallquwei()Dim i As Byte, j As Byte, k As Byte, n As Integer, arr(1 To 1000, 1 To 10)n = 1For i = 16 To 87For j = 1 To IIf(i = 55, 89, 94)k = k + 1arr(n, k) = Chr("&H" & Hex(i

2006-11-03 19:29:00 9908

原创 两个Listbox的关联(省名 和 该省城市的对应)

  Dim   prov   As   New   Collection         Private   Sub   Form_Load()     prov.Add   "北京市,东城,西城,崇文,宣武,朝阳,丰台,石景山,海淀,门头沟,房山,通州,顺义,昌平,大兴,平谷,怀柔,密云,延庆",   "北京"     prov.Add   "上海市,黄浦,卢湾,徐汇,长宁,静安,普陀,闸北,虹

2006-11-03 09:45:00 9355

原创 Select m elements from max elements with limits

I have max  integers between 1 and max,  If I choose m of them to get  a sum sums ,Suppose I have counts ways,How can I get the counts ?I write some codes by recursion---------------------------

2006-10-27 21:22:00 1126

转载 科场的胜者

  诗云:              人生凡事有前期,尤是功名难强为。             多少英雄埋没杀,只因莫与指途迷。        有个该中了,撞着人来帮村的。湖广有个举人姓何,在京师中会试,偶入酒肆,见一伙青衣大帽人在肆中饮酒。听他说话半文半俗,看他气质假斯文带些光棍腔。何举人另在一座,自斟自酌。这些人见他独自一个寂寞,便来邀他同坐。何举人不辞,就便随和欢畅。这些人道

2006-10-24 15:38:00 1093

原创 任意钝角三角形都可以分割为7个锐角三角形

任意钝角三角形都可以分割为7个锐角三角形  

2006-10-20 17:52:00 2598

原创 Great Common Divisor & Least Common Multiple(最大公约数和最小公倍数)

 Function ZDGYS(ByVal m As Long, ByVal n As Long) As Long Great Common DivisorZDGYS = mWhile n > 0m = ZDGYS Mod nZDGYS = nn = mWendEnd FunctionFunction ZXGBS(ByVal m As Long, ByVal n As Long) As

2006-10-19 23:16:00 1288 1

原创 A macro to get all interior colorindex has been used in thisworkbook

1集合的方法:Sub getallcolor()Dim sh As Worksheet, x As New Collection, colors(), c As Range, i As LongOn Error Resume NextFor Each sh In SheetsFor Each c In sh.UsedRangex.Add c.Interior.ColorIndex, "key"

2006-09-28 23:28:00 1249

原创 VB6求两个字符串最长公共子串的问题

Function LCS(ByVal A As String, ByVal B As String) As StringIf Len(A) * Len(B) = 0 Then LCS = "": Exit FunctionDim la As Integer, lb As Integer, achar() As String, bchar() As String, c() As Integer, i

2006-09-28 23:21:00 2514

原创 24点

在a1,a2,a3,a4单元格内输入数字,如果能算24点的话在b列显示解法,如果有多种解法则分别在b1,b2...中显示: Sub get24p()Const p24 = "123412431324134214231432213421432314234124132431312431423214324134123421412341324213423143124321"Dim A As Int

2006-09-28 22:05:00 1310

原创 EXCEL VBA]EXCEL中用递归实现任意n(3≤n≤256)阶幻方

下面代码将实现任意n(3≤n≤256)阶幻方,显示在EXCEL的 A1:IV256中Sub magicsquare(ByVal n As Long, ByRef matrix())Dim i As Long, j As Long, k As Long, p As Long, a(), temp As New CollectionReDim matrix(1 To 256, 1 To 256)I

2006-09-28 22:04:00 2778

转载 InputBox with Password Characters(转帖)

The following codes are  from http://www.freevbcode.com/ShowCode.asp?ID=1214Add a form with commandbutton:Private Sub Command1_Click()  Dim ret As String  SetTimer hwnd, NV_INPUTBOX, 10, AddressO

2006-08-29 09:12:00 1263

原创 VB计算圆周率(二)

采用普遍的傅立叶级数展开方法pi = 3 + (1 * 1) / (2 * 3 * 4) * [ 3 + (3*3)/(4*5*4) *[ 3 + (5*5)/(6*7*4) * [ 3 + (7*7)/(8*9*4) * [ ... ] ] ] ]输入:需计算的圆周率位数,理论精度约5万位 Add a commandbutton and textbox(multine=true,s

2006-06-07 09:15:00 5526 1

原创 递归方法巧解不定方程(二)

笔者在2004年曾写过一篇 递归方法巧解不定方程 。昨天在一位网友的启发下,对代码进行了重写,使其能够设置每个变量的取值范围。代码如下Private Sub Command1_Click()Dim min(1 To 5) As Integer, max(1 To 5) As Integer, RESULTmin(1) = 2min(2) = 3max(1) = 3max(2) = 7jiefa

2006-06-07 09:05:00 1713

原创 VB计算圆周率

采用普遍的傅立叶级数展开方法 pi=2+1/3*(2+2/5*(2+3/7*(2+4/9*(2+5/11  .....))))))输入:需计算的圆周率位数,理论精度约30万位 Add a commandbutton and textbox(multine=true,scrollbars=both) to form1Option Explicit Private Sub C

2006-06-06 09:30:00 9412

原创 设置文本框的九种对齐方式(左上,中上,右上,左中,中中,右中,左下,中下,右下)

Add a commandbutton and a textbox( multiline=true) and copy the following codes to form1:Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Lo

2006-06-05 12:00:00 5029

原创 EXCELSHEET 中"输入”或“编辑”状态与“就绪”状态的切换

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Sub Macro1()Dim i As IntegerFor i = 1 To 5   Sheet1.Range("D10").Select    ActiveCell.Activate    SendKeys " "    Sleep 1000    D

2006-06-04 07:59:00 2913

原创 已知三角形三个边的长度值,求三个角的大小

没什么技术含量,一个余弦定理搞定:Function angle(ByVal a As Double, ByVal b As Double, ByVal c As Double)angle = (b * b + c * c - a * a) / (2 * b * c)angle = Atn(-angle / Sqr(1 - angle * angle)) + 2 * Atn(1)angle =

2006-06-04 07:54:00 5311

原创 获取路径名的原始大小写状态

方法1:利用dir()循环:------------------------------------Option ExplicitPrivate Sub Command1_Click()Dim s As Strings = "c:/program files/microsoft office/office11/winword.exe"MsgBox "lcase: " & s &

2006-06-04 07:44:00 1369

原创 VB实现小数和分数的相互转化

Function fenshu(ByVal xiaoshu As Single, Optional ByVal jingdu As Integer = 3) As String 小数转换为分数,误差小于0.1^jingduDim i As LongDoi = i + 1Loop Until Abs((i / xiaoshu) - Round((i / xiaoshu), 0)) fenshu =

2006-06-03 21:21:00 4408

原创 全国专业技术人员计算机应用能力考试

全国专业技术人员计算机应用能力考试     虚拟光驱下载位置:    http://download.fsyyy.com/SoftView/SoftView_80.html                                                                                 有关的使用方法请参看:    http

2006-05-17 11:50:00 11828

原创 快速删除一个包含文件和子文件夹的文件夹

调用DOS命令rmdir 删除一个具有多级目录的目录Private Sub KillFolder(MyFolderPath As String)Shell "cmd.exe /c rmdir /s/q " & Chr(34) & MyFolderPath & Chr(34)End Sub Private Sub Command1_Click()KillFolder "C:/Temp

2006-05-10 09:33:00 1650 1

原创 不绑定记录集获取datagrid某行某列的内容

获取Dvatagrid第r行c列的内容可以用下面代码获得DataGrid1.Col = rDataGrid1.Row = cmsgbox DataGrid1.Text  但如果datagrid1中有滚动条,要得到滚动下面某行某列的内容时,系统会提示说:行号无效!这是由于DataGrid1.Row只能在[1,datagrid.visiblerows]间取值。当行号大于visibler

2006-05-10 09:23:00 2729 2

原创 将某网页的某框架内容显示在WEBBROWSER中

下面代码可以实现将某网页的某框架内容显示在新的WEBBROWSER中.add two webbrowser and a commandbutton to form1:Private Sub Command1_Click()Dim html As Stringhtml = WebBrowser1.Document.frames(4).Document.body.innerHTMLhtml

2006-05-07 19:34:00 1219

原创 输出螺旋矩阵(三)

输出这样的二维阵列:1  2  3     4 12 13 14 511 16 15 610 9  8    7分析:填充如此一个n*n阵列 ,先观察规律:n=1 1n=21 24 3对于n*n阵列,可以先将1-4*n 填充四周,内部用一个(n-2)*(n-2) 的阵列加上4*(n-1)填充,所以用递归比较直观,代码如下:Private Sub Command1

2006-05-07 19:26:00 1533

原创 输出螺旋矩阵(二)

输出这样的二维阵列:1  3  4  10  112  5  9  12  196  8  13 18  207  14 17 21  2415 16 22 23  25 Sub spiralmetrix(ByVal n As Integer)n = n - 1Dim i As Integer, j As Integer, a() As IntegerReDim a(n, n)a(0,

2006-05-07 19:10:00 1318

原创 输出螺旋矩阵(一)

输出这样的二维阵列:1     2    3   4 12 13 14   511 16 15   610  9    8    7 Private Sub Command1_Click()spiral 17Debug.Printspiral 18End SubSub spiral(ByVal n As Integer)Dim temp() As Long, i As Long,

2006-05-07 19:05:00 1394

原创 利用 wordXP 实现自动排班

许多工作岗位需要每天或每月排一次班,如何用WORD实现自动排班?笔者曾对此做过一些研究,不尽人意.在一位网友(chewinggum(口香糖·把减肥列入下一个五年计划) )提供了很不错的代码(http://community.csdn.net/Expert/topic/4304/4304006.xml?temp=.7863428),稍做了一些改动,感觉效果还可以.新建WORD文档,ALT+F

2006-05-07 18:35:00 3107 1

空空如也

空空如也

TA创建的收藏夹 TA关注的收藏夹

TA关注的人

提示
确定要删除当前文章?
取消 删除