本示例重複最近用戶介面命令。本示例必須放在宏的第一行。
Application.Repeat
下例中，變量 counter 代替了行號。此過程將在單元格區域 C1:C20 中循環，將所
有絕對值小於 0.01 的數字都設置爲 0（零）。
Sub RoundToZero1()
For Counter = 1 To 20
Set curCell = Worksheets("Sheet1").Cells(Counter, 3)
If Abs(curCell.Value) 0 Then
' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL 6
在 Ne00:" '指定列印機
ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,
Collate:=True '設置列印資訊,其中Copies:=myPrint爲列印份數
Else
MsgBox "請輸入要列印的份數"
End If
ActiveSheet.ShowAllData '全部顯示
ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼
Sheets("封面").Select
Application.ScreenUpdating = True
End Sub
Sub 列印餘額()
Application.ScreenUpdating = False
Sheets("餘額表").Select
Call 重算所有表
ActiveSheet.Unprotect Password:=641112 '撤銷工作表保護並取消密碼
ActiveWindow.ScrollColumn = 10
Selection.AutoFilter Field:=1, Criteria1:=""
'以下10行彈出視窗輸入列印資訊
Dim myPrintNum As Integer
Dim myPrompt, myTitle As String
myPrompt = "請輸入要列印的份數"
myTitle = "列印選取範圍"
myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)
If myPrintNum 0 Then
' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL 6 在
Ne00:" ' '指定列印機
ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,
Collate:=True '設置列印資訊,其中Copies:=myPrint爲列印份數
Else
MsgBox "請輸入要列印的份數"
End If
ActiveSheet.ShowAllData '全部顯示
ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼
Sheets("封面").Select
Application.ScreenUpdating = True
End Sub
Sub 備份()
Dim y '變量聲明-需保存工作表的路徑和名稱
[M1] = ActiveWorkbook.FullName '單元格M1=當前工作簿的路徑和名稱
y = cells(1, 14) 'Y=單元格N1的值,即計算後的需保存工作簿的
路徑和名稱
Worksheets("封面").UsedRange.Columns("M:N").Calculate '計算指定
區域
ActiveWorkbook.SaveCopyAs y '備份到指定路麽Y
End Sub
Sub 重算活動表()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
ActiveWindow.DisplayZeros = True
ActiveSheet.Calculate
End Sub
Sub 重算指定表()
Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"
Worksheets("銀行帳").Calculate
Worksheets("日報表").Calculate
End Sub
單元格數據改變引起計算啟動過程
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irow, icol As Integer
irow = Target.Row '變量行irow
icol = Target.Column '變量列icol
If irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3)
Then '>大於6行,並且第3列,當本行 3列>2行3列
Application.EnableEvents = False
cells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列
Application.EnableEvents = True
ElseIf irow > 6 And icol = 3 And cells(irow, 3) 大於6行,並且第3列,當本行 3列>2行3列
Application.EnableEvents = False
cells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1
Application.EnableEvents = True
ElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Or
icol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target
""
Application.EnableEvents = False
cells(irow, 5) = "=單位名稱"
cells(irow, 7) = "=摘要"
cells(irow, 11) = "=餘額"
Range(cells(irow, 14), cells(irow, 16)) = "=預內外收支NOP"
cells(irow, 17) = "=審核Q"
cells(irow, 18) = "=對帳U"
Range(cells(irow, 19), cells(irow, 20)) = "=內轉收支XY"
cells(irow, 21) = "=政采Z"
Application.EnableEvents = True
End If
End Sub
'計算當前工作表路徑及名稱的函數,可作爲單元格公式,也可寫入宏
=CELL("FILENAME")
'改變Excel介面標題的巨集
Private Sub Workbook_Open()
Application.Caption = "吃過了"
End Sub
'自動刷新單元格A1內顯示的日期\時間的宏
Sub mytime()
Range("a1") = Now()
Application.OnTime Now + TimeValue("00:00:01"), "mytime"
End Sub
'用單元格A1的內容作爲檔案名保存當前工作簿的宏
Sub b()
ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"
End Sub
'啟動窗體的巨集,此巨集寫入有窗體的工作表內
Private Sub CommandButton1_Click() '點數據錄入按鈕控制項啟動窗體
Load UserForm3 '啟動窗體
UserForm3.StartUpPosition = 3 '啟動窗體
UserForm3.Show '啟動窗體
End Sub
'以下爲窗體中點擊各按鈕運行的宏,寫入窗體內
Public pos As Integer '聲明變量pos
'戰友確定按鈕語句
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False '此句和最後一句旨在不顯
示宏的執行過程
'On Error GoTo ErrorHandle '可以不要
'ErrorHandle: '可以不要
'If Err.Number = 13 Then '可以不要
'Exit Sub '可以不要
'End If '可以不要
Call writeToWorkSheet '執行宏writetoworksheet
UserForm3.Hide '退出窗體,繼續按鈕少此句,退出按鈕執行此句
Unload UserForm3 '退出窗體,繼續按鈕少此句,退出按鈕執行此句
Call 批量列印 '[此處到接順序2]
[L2] = "" '[到此處結束]
Sheets("列印資訊").Select
Application.ScreenUpdating = True
End Sub
'退出按鈕語句
Private Sub CommandButton2_Click()
UserForm3.Hide
Unload UserForm3
End Sub
'將窗體內的文字方塊中的數據寫進工作表的單元格
Private Sub writeToWorkSheet()
ActiveSheet.Range("k2") = TextBox1.Value '將文字框內容寫進k列
ActiveSheet.Range("l2") = TextBox2.Value '將文字框內容寫進l列
TextBox1.Value = "" '清空文字框內容
TextBox2.Value = "" '清空文字框內容
Worksheets("列印資訊").Range("a2").Value = 1 '給指定表的單元格寫入
數據
Worksheets("列印資訊").Range("B3:E113").Value = "" '清空指定表的單元
格數據
End Sub
'以下爲根據條件列印的宏
Sub 列印() '部門明細查詢及批星列印
Application.ScreenUpdating = False '關閉螢幕更新
If Cells(1, 4) = "" And Cells(1, 5) = "" Then '列印條件Cells(3,
13) = 1 And
' Application.ActivePrinter = "\zdserver2HP LaserJet 5000 PCL
6 在 Ne00:" ' '指定列印機
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'設置默認列印機的列印資訊,其中Copies:=myPrint爲列印份數
Else
Call 列印資訊 '打倒爲假時執行
End If
Application.ScreenUpdating = True '關閉螢幕更新
End Sub
'以下的循環過程,也用於批量列印,Z的值可以是Z=1 TO 5(1到5),也可是單元格的內
容
Sub 批量列印()
For Z = Cells(1, 11) To Cells(1, 12) '變量X的值從列印起始號K1到結束
號L1之間逐漸遞增
Cells(1, 13) = Z 'M1的值等於變量X
Next Z
End Sub
'以下是將列印情況寫入工作表的宏
Sub 列印資訊()
Application.ScreenUpdating = False '關閉螢幕更新
Dim Y '聲明變量
Y = ActiveSheet.Name '判定活動工作表名稱
Sheets("列印資訊").Select
X = 3 '從第3行開始
Do While Not (IsEmpty(Cells(X, 2).Value)) '判斷第1列的最後一行(
即空行的上一行)
X = X + 1 '在最後一行加一行即爲空行
Loop
Cells(X, 2) = Cells(2, 1)
Cells(X, 3) = Sheets(Y).Cells(4, 3)
Cells(2, 1) = Cells(2, 1) + 1
Cells(X, 4) = Sheets(Y).Cells(1, 4)
Cells(X, 5) = Sheets(Y).Cells(1, 5)
[c1] = Y
Sheets(Y).Select '返回上一次打開的工作表
Application.ScreenUpdating = True '打開螢幕更新
End Sub
將檔保存爲以某一單元格中的值爲檔案名的宏怎麽寫
假設你要以Sheet1的A1單元格中的值爲檔案名保存，則應用命令：
ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"
在Excel中,如何用程式控制某一單元格不可編輯修改?thanks!!!
Private Sub Workbook_Open()
ProtectSpecialRange ("A1")
End Sub
Sub ProtectSpecialRange(RangeAddress As String)
On Error Resume Next
With Sheet1
.Cells.Locked = False
.Range(RangeAddress).Locked = True
.Protection.AllowEditRanges.Add Title:="區域1", Range:=Range
(RangeAddress) _
, Password:="pass"
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub
對工作表編程，有時要判斷工作表的記錄總數，VBA裏如何實現？
x=1
do while not (isempty(sheets("").cells(x,1).value)
x=x+1
loop
在VBA中等同于EXCELE中的求和函數-sum()-的函數是什麽?
Application.WorksheetFunction.Sum()
自定義菜單有三個菜單項，要求手工順序執行。爲防止誤操作，執行完第一個菜單項
後使其變灰（禁用），如何寫？
Rowen
令其 Enable屬性同步與某個工具按鈕是較爲方便的。
如何進行表格更新？
是這樣的，比如我已經有了一個原始表格A，這時有人通知我A表有錯誤，須加以修改
，並給我一個表B，表B列出了須修改的參數（注意B的列數少於A的列數，因A的其他
列無需修改）。現在問題是如何根據表B中的新值，在表A中找到相應位置，並加以修
改。比如表B中列出了10002的JOHN的身高和體重等值需要修改，如何在A中找到
10002的相應位置（身高體重），並加以修改。
建議將表b複製至表a的sheet2，然後執行下列的宏即可
sub change()
dim dd as range
sheets(2).select
lastcell = range("a65536").end(xlup).row
for each dd in range(cells(2, 1), cells(lastcell, 1))
if dd = "" then exit sub
ff = dd.value
set c = sheets(1).columns(1).find(ff, lookat:=xlwhole)
if not c is nothing then
c.offset(0, 2) = dd.offset(0, 2)
c.offset(0, 3) = dd.offset(0, 3)
c.offset(0, 5) = dd.offset(0, 4)
end if
next
end sub
相關閱讀...
Excel VBA 使用函數範例參考之一
Excel VBA 使用函數範例參考之二
Excel VBA 使用函數範例參考之三
Excel VBA 使用函數範例參考之四
Excel VBA 使用函數範例參考之六
沒有留言:
張貼留言