|
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 '激活窗体 |