If Abs(curCell.Value) 0 Then
' Application.ActivePrinter = "//zdserver2/HP 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 = "//zdserver2/HP 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 '激活窗体