各种Excel VBA的命令2

本示例重复最近用户界面命令。本示例必须放在宏的第一行。application.Repeat

下例中，变量 counter 代替了行号。此过程将在单元格区域 C1:C20 中循环，将所

有绝对值小于 0.01 的数字都设置为 0（零）。Sub RoundToZero1()For Counter = 1 To 20Set curCell = Worksheets(“Sheet1”).Cells(Counter, 3)If Abs(curCell.Value) 0 Then’ Application.ActivePRinter = “\\zdserver2\HP LaserJet 5000 PCL 6

在 Ne00:” ‘指定打印机ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,

Collate:=True ‘设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox “请输入要打印的份数”End IfActiveSheet.ShowAllData ‘全部显示ActiveSheet.Protect PassWord:=641112 ‘ 保护工作表并设置密码Sheets(“封面”).SelectApplication.ScreenUpdating = TrueEnd Sub

Sub 打印余额()Application.ScreenUpdating = FalseSheets(“余额表”).SelectCall 重算所有表ActiveSheet.Unprotect Password:=641112 ‘撤消工作表保护并取消密码ActiveWindow.ScrollColumn = 10Selection.AutoFilter Field:=1, Criteria1:=””‘以下10行弹出窗口输入打印信息Dim myPrintNum As IntegerDim myPrompt, myTitle As StringmyPrompt = “请输入要打印的份数”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为打印份数ElseMsgBox “请输入要打印的份数”End IfActiveSheet.ShowAllData ‘全部显示ActiveSheet.Protect Password:=641112 ‘ 保护工作表并设置密码Sheets(“封面”).SelectApplication.ScreenUpdating = TrueEnd Sub

Sub 备份()Dim y ‘变量声明-需保存工作表的路径和名称[M1] = ActiveWorkbook.FullName ‘单元格M1=当前工作簿的路径和名称y = cells(1, 14) ‘Y=单元格N1的值,即计算后的需保存工作簿的

路径和名称Worksheets(“封面”).UsedRange.Columns(“M:N”).Calculate ‘计算指定

区域ActiveWorkbook.SaveCopyAs y ‘备份到指定路么YEnd Sub

Sub 重算活动表()With Application.Calculation = xlManual.MaxChange = 0.001End WithActiveWorkbook.PrecisionAsDisplayed = TrueActiveWindow.DisplayZeros = TrueActiveSheet.CalculateEnd Sub

Sub 重算指定表()Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = “z\n14″Worksheets(“银行帐”).CalculateWorksheets(“日报表”).CalculateEnd Sub

单元格数据改变引起计算激活过程Private Sub Worksheet_Change(ByVal Target As Range)Dim irow, icol As Integerirow = Target.Row ‘变量行irowicol = Target.Column ‘变量列icolIf irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow – 1, 3)

Then ‘>大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow – 1, 2) ‘本行 2 列=上一行2列Application.EnableEvents = TrueElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow – 1, 2) + 1 ‘本行 2 列=上行2列+1Application.EnableEvents = TrueElseIf (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 = Falsecells(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 = TrueEnd IfEnd 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 ‘执行宏writetoworksheetUserForm3.Hide ‘退出窗体,继续按钮少此句,退出按钮执行此句Unload UserForm3 ‘退出窗体,继续按钮少此句,退出按钮执行此句Call 批量打印 ‘[此处到接顺序2][L2] = “” ‘[到此处结束]Sheets(“打印信息”).SelectApplication.ScreenUpdating = TrueEnd Sub

‘退出按钮语句Private Sub CommandButton2_Click()UserForm3.HideUnload UserForm3End 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 = “\\zdserver2\HP LaserJet 5000 PCL

6 在 Ne00:” ‘ ‘指定打印机ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

‘设置默认打印机的打印信息,其中Copies:=myPrint为打印份数ElseCall 打印信息 ‘打倒为假时执行End IfApplication.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的值等于变量XNext ZEnd Sub

‘以下是将打印情况写入工作表的宏Sub 打印信息()Application.ScreenUpdating = False ‘关闭屏幕更新Dim Y ‘声明变量Y = ActiveSheet.Name ‘判定活动工作表名称Sheets(“打印信息”).SelectX = 3 ‘从第3行开始Do While Not (IsEmpty(Cells(X, 2).Value)) ‘判断第1列的最后一行(

即空行的上一行)X = X + 1 ‘在最后一行加一行即为空行LoopCells(X, 2) = Cells(2, 1)Cells(X, 3) = Sheets(Y).Cells(4, 3)Cells(2, 1) = Cells(2, 1) + 1Cells(X, 4) = Sheets(Y).Cells(1, 4)Cells(X, 5) = Sheets(Y).Cells(1, 5)[c1] = YSheets(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 NextWith Sheet1.Cells.Locked = False.Range(RangeAddress).Locked = True.Protection.AllowEditRanges.Add Title:=”区域1″, Range:=Range

(RangeAddress) _, Password:=”pass”.Protect DrawingObjects:=True, Contents:=True, Scenarios:=TrueEnd WithEnd Sub

对工作表编程，有时要判断工作表的记录总数，VBA里如何实现？x=1do while not (isempty(sheets(“”).cells(x,1).value)x=x+1loop

在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 rangesheets(2).selectlastcell = range(“a65536”).end(xlup).rowfor each dd in range(cells(2, 1), cells(lastcell, 1))if dd = “” then exit subff = dd.valueset c = sheets(1).columns(1).find(ff, lookat:=xlwhole)if not c is nothing thenc.offset(0, 2) = dd.offset(0, 2)c.offset(0, 3) = dd.offset(0, 3)c.offset(0, 5) = dd.offset(0, 4)end ifnextend sub

自定义菜单把建立和删除自定义菜单的代码分别写在Workbook_open和Workbook_beforeclosed

的事件中。

应该用VBA，工作薄代码中有workbook-open()过程，在该过程中写入with activeworkbook.sheets(“表2”).activeend with

VBA实现向锁定工作表中插入行,并自动复制上面行中指定列的函数Option ExplicitPublic Const strPass = “123” 123是口令Sub 行上再插入一行()ActiveSheet.Unprotect password:=strPassSelection.CopySelection.Insert Shift:=xlDownSelection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,

SkipBlanks:= _False, Transpose:=FalseApplication.CutCopyMode = FalseActiveSheet.Protect password:=strPassEnd Sub

如何使不出现每次关闭XLS文件时出现的：“XXX.xls文件已被修改，是否可在其修改后的内容？”字样？？可以在工作表关闭之前进行手工保存工作ThisWorkbook.save

如何实现动态时间显示?sub mytimerange(“a1”)=now()Application.OnTime Now + Timevalue(“00:00:01”), “mytime”end sub

用 vba 判断指定 excel 文件是否打开？For Each w In WorkbooksIf w.Name XXX Then…………End IfNext w

vba怎么调用excel自带的函数?比如vlookup?Application.WorksheetFunction.f(x)f(x)是你想使用的工作表函数但是用内部函数时引用单元格会出错，怎么办？把你要引用的单元格改成VBA认可格式（类型）。如在Excel中的“F7:F12”应改为

“Range(“F7:F12”)”等。

VBA中如何关闭,保存和退出Excel?Workbooks(“你的工作簿”).Save。

下表举例说明了使用 Rows 和 Columns 属性的一些行和列的引用。引用 含义Rows(1) 第一行Rows 工作表上所有的行Columns(1) 第一列Columns(“A”) 第一列Columns 工作表上所有的列若要同时处理若干行或列，请创建一个对象变量并使用 Union 方法，将对 Rows 属

性或 Columns 属性的多个调用组合起来。下例将活动工作簿中第一张工作表上的第

一行、第三行和第五行的字体设置为加粗。Sub SeveralRows()Worksheets(“Sheet1”).ActivateDim myUnion As RangeSet myUnion = Union(Rows(1), Rows(3), Rows(5))myUnion.Font.Bold = TrueEnd Sub

如果只是你说的只连接几个储存格那用简单的方法Range(“A1”).Formula = Application.Evaluate(“=[Book2.xls]Sheet1!A1”)或Range(“A1”).Formula = “=[Book2.xls]Sheet1!A1”

请问在vba如何呼叫已定义的名称范围

我在a1:b100插入名称∶myrange请问我如何用vba选取此范围Range(“myrange”).Select

如何访问没有打开的EXCEL文件？Sub AlternativeImport()Dim xlapp As Excel.ApplicationDim wbSource As Excel.WorkbookSet xlapp = New Excel.Applicationxlapp.EnableEvents = FalseSet wbSource = xlapp.Workbooks.Open(“C:\test\Book2.xls”)Range(“A1:A10”).Value = wbSource.Sheets(“Sheet1”).Range

(“A1:A10”).ValuewbSource.Close Falsexlapp.QuitEnd Sub

怎样使VBAprject工程不可查看？（不用密码）用可编辑十六进制文件的软件工具（如WinHex等）打开Excel.xls,在文件的尾部,查

找ID=”{00000000-0000-0000-0000-000000000000}”(有工程锁定密码时),或

ID=”{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}”(没有工程锁定密码时),修改其中

的任意1位后,保存,即可达到目的.当查看工程是会出现“工程不可查看”的提示.注意:修改前,一定要备份原文件,以防不测

如何用VBA控制报表的格式（左边距，纸张大小，打印第几页等）打印第几页控制:ActiveWindow.SelectedSheets.PrintOut From:=x, To:=yActiveSheet.PageSetup.LeftMargin= 左边距ActiveSheet.PageSetup..PaperSize = 纸张大小

如何使VBA自动消除使用COPY复制后产生的虚线框？Application.CutCopyMode = False

替换Excel 97的菜单栏是很容易的，只需创建一个新的菜单栏就会删除Excel 97的

菜单栏。当需要恢复Excel 97的菜单栏时，只要删除新创建的菜单栏就可以了。该

系统的自定义菜单中只需两个命令按钮，一个用来返回到系统的主画面

（ReturnMAIN），另一个用来退出系统（ExitSYS）。下面是模块（Module）中有关

的宏或是事件控制程序。Sub ZapMenu( )On Error Resume NextCommandBars(“保险查询系统”).DeleteEnd Sub这是一个用来删除自定义菜单栏的宏。语句On Error Resume Next保证无论自

定义菜单栏是否存在都能正确删除它。Sub ExitSYS( )ZapMenuActiveWorkbook.Close SaveChanges := FalseEnd Sub这是用来退出系统的宏。它删除自定义菜单，并关闭活动的工作簿（不提示保存

修改）。Sub ReturnMAIN( )Worksheets(“保险查询系统”).SelectEnd Sub该宏用来返回主画面。它激活“保险查询系统”工作表。Sub SetMenu( )Dim myBar As CommandBarDim myButton As CommandBarButtonZapMenuSet myBar = CommandBars.Add(Name:=“保险查询系统”, _Position :=msoBarTop, _MenuBar :=True)Set myButton = myBar.Controls.Add(msoControlButton)myButton. = msoButtonCaptionmyButton.Caption = “退出[&E]”myButton.OnAction = “ExitSYS”Set myButton = myBar.Controls.Add(msoControlButton)myButton. = msoButtonCaptionmyButton.Caption = “返回[&R]”myButton.OnAction = “ReturnMAIN”myButton.Visible = FalsemyBar.Protection = msoBarNoMove + msoBarNoCustomizemyBar.Visible = TrueEnd Sub这个宏包含五部分。第一部分定义了一对变量。第二部分首先运行ZapMenu宏，

保证保险查询系统菜单栏是不存在的，然后创建它。参数MenuBar的值设为True，确

保这个新创建的命令栏为一菜单栏。第三部分和第四部分将两个命令按钮加入到菜单

栏中。并设置ReturnMAIN命令按钮的初始状态为不可见状态。最后一部分保护这个

新创建的菜单栏，使用户不能移动也不能自定义新菜单栏。

工作表汇总Sub sum() ‘表汇总,第1张的a1:e20等于所有表的相同单元格的和Attribute sum.VB_ProcData.VB_Invoke_Func = “z\n14″Dim X As WorksheetFor y = 1 To 20For z = 1 To 5For Each X In Worksheetsshname = X.NameActiveSheet.Cells(y, z).Value = ActiveSheet.Cells(y, z).Value +

Worksheets(shname).Cells(y, z)NextNext zNext yEnd Sub