- 博客(229)
- 收藏
- 关注
RSS订阅原创 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
原创 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关注的人