1.判断一个表的最后一行:
i = Range("A65536").End(xlUp).Row
2.取最后一列列号:
m = Range("dz1").End(xlToLeft).Column
3.遍历工作簿中所有表
i=1
For Each m In Sheets '遍历每个工作表
cells(i,1)=m.name '取工作表名
cells(i,2)=sheets(m.name).cells(1,1) '取工作表第一个单元格内容
i=i+1
next
4.求某月天数
Function tianshu(riqi As Date) As Byte
tianshu = DateSerial(Year(riqi), Month(riqi) + 1, Day(riqi)) - riqi
End Function
'求月末日期
Function yuemo(riqi As Date) As Date
yuemo = DateSerial(Year(riqi), Month(riqi) + 1, 0)
End Function
5.禁止别人运行Word程序的VBA代码禁止别人运行Word程序的VBA代码
单击“工具→宏→宏…”命令,在弹出的对话模型中输入宏名“autoexec”,然后单击“创建”,在代码窗中输入如下内容,即可控制别人 运行WORD:
Sub autoexec()
Dim psw As String
psw = inputbox("请输入密码:", "登录?")
If psw = "elong" Then
Application.ShowMe
Else
msgbox "对不起,请您与本机主人联系!"
Application.Quit
End If
End Sub
破解办法:
(1)、禁止自运行宏、
(2)、或者直接删除normal.dot模板文件即可。
补充:
这个代码也可以用在Excel中,只是函数名换成Auto_Open()即可
6.在编程时,时常需要知道工作表是否存在,文件是否存在等,这时候,以下这些自定义函数就能派上用场了:
Private Function FileExists(fname) As Boolean
'当文件存在时返回true
Dim x As String
x = Dir(fname)
If x <> "" Then FileExists = True _
Else FileExists = False
End Function
Private Function FileNameOnly(pname) As String
'返回路径pname的文件名
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = Application.PathSeparator Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function
Private Function PathExists(pname) As Boolean
'如果路径pname存在则返回true
Dim x As String
On Error Resume Next
x = GetAttr(pname) And 0
If Err = 0 Then PathExists = True _
Else PathExists = False
End Function
Private Function RangeNameExists(nname) As Boolean
'如果一个名称存在则返回true
Dim n As Name
RangeNameExists = False
For Each n In ActiveWorkbook.Names
If UCase(n.Name) = UCase(nname) Then
RangeNameExists = True
Exit Function
End If
Next n
End Function
Private Function SheetExists(sname) As Boolean
'如果活动工作簿中存在表SNAME则返回真
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Private Function WorkbookIsOpen(wbname) As Boolean
'如果工作簿WBNAME打开着,则返回true
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function
7.关于远程写入数据:
需要了解如下对象:
Application:Excel应用程序。
Workbook:Excel工作簿。
WorkSheet:Excel工作表。
如何创建一个Excel应用程序
创建Excel应哟功能程序使用的是CreateObject()函数
看下面的例子:
打开Word,进入VBAIDE,添加模块后写入如下代码:
Public Sub test()
Dim app As Excel.Application
Dim book As Workbook
Dim sheet As Worksheet
Set app = CreateObject("Excel.Application")
Set book = app.Workbooks.Add
MsgBox book.Name
For Each sheet In book.Worksheets
MsgBox sheet.Name
Next sheet
Set sheet = book.Worksheets(1)
sheet.Cells(1, 1) = "Hello"
book.SaveAs "C:\Hello.xls"
book.Close
Set sheet = Nothing
Set book = Nothing
Set app = Nothing
End Sub
8.个可以让Excel、Access等程序播放声音文件的函数(只能放WAV文件)
会让你的系统或者表格别具一格哦 :)
使用方法:=PlaySound("声音文件名.WAV") (声音文件必须含路径和扩展名)
=PlaySound(A1) (A1单元格中存放声音文件名)
Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
(ByVal filename As String, ByVal snd_async As Long) As Long
Function PlaySound(sWavFile As String)
If apisndPlaySound(sWavFile, 1) = 0 Then
MsgBox "The Sound Did Not Play!"
End If
End Function
联系客服