自學(xué)資料(Excel VBA)[收集整理3] 45、自定義函數(shù)
Public Function Now1() Dim string1 As String string1 = VBA.Date Now1 = string1 End Function 46、復(fù)制 Sub copy1() Sheet2.Range("C5:C10").Copy Sheet1.Range("C5:C10") End Sub 47、如何統(tǒng)計(jì)表中sheet的個數(shù)? msgbox sheets.count Columns("G:G").Select 48、 Selection.EntireColumn.Hidden = True 這樣隱藏有個毛病,如何解決?如果A1:G1單元格合并的話,就把A:G列均隱藏了。 Columns("G:G").EntireColumn.Hidden = True 49、在VBA中引用excel函數(shù)的方法 1). Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10" 2). Sheet1.Cells(1,1).Formula = "=" & Sheets(iii).Name & "!R1C4" 在宏中用R1C1方式寫時表格1的A1中會在寫為“=Sheet2!$D$1” 用這種方式,想用什么函數(shù)就用什么函數(shù). 50、選定下(上)一個工作表 sheets(activesheet.index-1).select sheets(activesheet.index+1).select 51、Private Sub Workbook_Open() ActiveWindow.DisplayWorkbookTabs = False '取消工作表標(biāo)簽 Application.CommandBars("Sheet").Controls(1).Enabled = False '格式_工作表不能重命名 Application.CommandBars.FindControl(ID:=889).Enabled = False '右鍵菜單不能重命名 End Sub 52、 [a65536].End(xlUp’A列從下往上第一個非空的單元格 53、Sub macro() Set rng = Range("C11:F13") 定義RNG為一個單元格區(qū)域 For Each cel In rng 定義CEL為RNG中的一個任一單元格 colo = cel.Interior.ColorIndex 定義 COLO 為單元格CEL的填充顏色 If colo <> -4142 Then 如果COLO的值不等于-4142 iR = [b65536].End(xlUp).Row + 1 IR等于B列數(shù)據(jù)區(qū)域的行數(shù)+1 If [a65535].End(xlUp).Value <> Cells(cel.Row, 2) Then Cells(iR, 1) = Cells(cel.Row, 2) 如果A列最后一個非空值單元格 不等于Cells(cel.Row, 2) 的值 那么單元格Cells(iR, 1) 的值等于Cells(cel.Row, 2) 的值 CEL.ROW是C11:F13中任意單元格的行號 Cells(iR, 2) = Cells(10, cel.Column) Cells(iR, 3) = cel.Value Cells(iR, 4) = IIf(colo = 36, "Yellow", "Red") Cells(iR, 4) 的值如果colo = 36那么值為"Yellow",否則值為"RED" next End Sub 54、Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) '**********運(yùn)行數(shù)據(jù)日志記錄********** Dim rng As Range If ActiveSheet.Name <> "主界面" And ActiveSheet.Name <> "目錄索引" Then For Each rng In Target.Cells Changecell = ActiveSheet.Name & ",單元格:" & rng.Address(0, 0) & ",更改為:" & rng.value & "。更改時間:" & Now CritOrAddtext Next End If End Sub 55、ActiveSheet.Unprotect '撤銷當(dāng)前工作表保護(hù) If ActiveSheet.Name <> "主界面" And ActiveSheet.Name <> "目錄索引" And Target.Row > 3 Then '行變色 On Error Resume Next [ChangColor_With].FormatConditions.Delete Target.EntireRow.Name = "ChangColor_With" With [ChangColor_With].FormatConditions .Delete .Add xlExpression, , "TRUE" .Item(1).Interior.ColorIndex = 4 End With End If ActiveSheet.Protect 56、在C1中弄個下拉無表,實(shí)際是有效性,你可以選擇A1:A4為C1單元格有效性的序列數(shù)據(jù)源,如果說C1不與A1:A4在同一表,則不能這么用,應(yīng)當(dāng)先對A1:A4命名,然后把數(shù)據(jù)源改為名稱. 57、自動增加工作表 進(jìn)入宏命令編輯窗口,在Sub 自動增加工作表()命令后依次鍵入如下宏命令內(nèi)容: Dim i&, userinto i = 0 userinto = InputBox("輸入插入工作表數(shù)量:") If IsNumeric(userinto) = True Then Do Until i = userinto Worksheets.Add i = i + 1 Loop End If End Sub 58、方法一(共享級鎖定): 1、先對EXCEL文件進(jìn)行一般的VBAProject”工程密碼保護(hù)。 2、打開要保護(hù)的文件,選擇:工具--->保護(hù)--->保護(hù)并共享工作簿--->以追蹤修訂方式共享-->輸入密碼-->保存文件。 完成后,當(dāng)你打開“VBAProject”工程屬性時,就將會提示:“工程不可看!“ 方法二(推薦,破壞型鎖定): 用16進(jìn)制編輯工具,如WinHex、Ultraedit-32(可到此下載)等,再歷害點(diǎn)的人完全可以用debug命令來做......用以上軟件打開EXCEL文件,查找定位以下地方: ID="{00000000-0000-0000-0000-000000000000}" 注:實(shí)際顯示不會全部為0 此時,你只要將其中的字節(jié)隨便修改一下即可。保存再打開,就會發(fā)現(xiàn)大功告成! 當(dāng)然,在修改前最好做好你的文檔備份。至于恢復(fù)只要將改動過的地方還原即可(只要你記住了呵呵)。 順便說一句,這種方法仍然是可破解的,因?yàn)榧用芸偸窍鄬Φ?。 59、Sub AddComments() '自動對ActiveSheet所有有公式格位加上註解 Set RG = Cells.SpecialCells(xlCellTypeFormulas) For Each c In RG c.AddComment c.Comment.Text Text:=c.Formula Next c End Sub Sub De_Comments() '自動消除所有註解 Set RG = Cells.SpecialCells(xlCellTypeFormulas) For Each c In RG c.ClearComments Next c End Sub 60、如何在Excel里使用定時器 www.aspsky.net 2002-3-12 20:53:27 動網(wǎng)先鋒 用過 Excel 97 里的加載宏 "定時保存" 嗎?可惜它的源程序是加密的,現(xiàn)在就上傳一篇介紹實(shí)現(xiàn)它的文檔。 在 Office 里有個方法是 application.on expr 如果想進(jìn)一步了解,請參閱 Excel 的幫助。 這個函數(shù)是用來安排一個過程在將來的特定時間運(yùn)行,(可為某個日期的指定時間,也可為指定的時間段之后)。通過這個函數(shù)我們就可以在 Excel 里編寫自己的定時程序了。下面就舉兩個例子來說明它。 1.在下午 17:00:00 的時候顯示一個對話框。 Sub Run_it() Application.On '設(shè)置定時器在 17:00:00 激活,激活后運(yùn)行 Show_my_msg 。 End Sub Sub Show_my_msg() msg = MsgBox("現(xiàn)在是 17:00:00 !", vbInformation, "自定義信息") End Sub 2.模仿 Excel 97 里的 "自動保存宏",在這里定時 5 秒出現(xiàn)一次 Sub auto_open() MsgBox "歡迎你,在這篇文檔里,每 5 秒出現(xiàn)一次保存的提示!", vbInformation, "請注意!" Call runtimer '打開文檔時自動運(yùn)行 End Sub Sub runtimer() Application.On ' Now + TimeValue("00:15:00") 指定在當(dāng)前時間過 5 秒鐘開始運(yùn)行 Saveit 這個過程。 End Sub Sub SaveIt() msg = MsgBox("朋友,你已經(jīng)工作很久了,現(xiàn)在就存盤嗎?" & Chr(13) _ & "選擇是:立刻存盤" & Chr(13) _ & "選擇否:暫不存盤" & Chr(13) _ & "選擇取消:不再出現(xiàn)這個提示", vbYesNoCancel + 64, "休息一會吧!") '提示用戶保存當(dāng)前活動文檔。 If msg = vbYes Then ActiveWorkbook.Save Else If msg = vbCancel Then Exit Sub Call runtimer '如果用戶沒有選擇取消就再次調(diào)用 Runtimer End Sub 以上只是兩個簡單的例子,有興趣的話,可以利用 Application.On Sub Show_my_msg() msg = MsgBox("現(xiàn)在是 17:00:00 !", vbInformation, "自定義信息") End Sub 2.模仿 Excel 97 里的 "自動保存宏",在這里定時 5 秒出現(xiàn)一次 Sub auto_open() MsgBox "歡迎你,在這篇文檔里,每 5 秒出現(xiàn)一次保存的提示!", vbInformation, "請注意!" Call runtimer '打開文檔時自動運(yùn)行 End Sub Sub runtimer() Application.On ' Now + TimeValue("00:15:00") 指定在當(dāng)前時間過 5 秒鐘開始運(yùn)行 Saveit 這個過程。 End Sub |
|