您的位置: 首页 > EXCEL技巧 > ExcelVBA >

各种Excel VBA的命令(下)

时间:2013-08-17 整理:docExcel.net

本示例反复最近用户界面呼吁。本示例必需宏的第一行。
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 = "\\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 '激活窗体
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 = "\\zdserver2\HP 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

自界说菜单
把成立和删除自界说菜单的代码别离写在Workbook_open和Workbook_beforeclosed

的事件中。

应该用VBA,事情薄代码中有workbook-open(),在该中写入
with activeworkbook
.sheets("表2").active
end with

VBA实现向锁定事情表中行,并自动复制上面行中指定列的函数
Option Explicit
Public Const strPass = "123" 123是口令
Sub 行上再一行()
ActiveSheet.Unprotect password:=strPass
Selection.Copy
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,

SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect password:=strPass
End Sub

如何使不呈现每次封锁XLS文件时呈现的:
“XXX.xls文件已被修改,是否可在其修改后的内容?”字样??
可以在事情表封锁之前举办手工生存事情
ThisWorkbook.save

如何实现动态显示?
sub mytime
range("a1")=now()
Application.OnTime Now + Timevalue("00:00:01"), "mytime"
end sub

用 vba 判定指定 excel 文件是否打开?
For Each w In Workbooks
If w.Name XXX Then
…………
End If
Next 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").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(3), Rows(5))
myUnion.Font.Bold = True
End 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.Application
Dim wbSource As Excel.Workbook
Set xlapp = New Excel.Application
xlapp.EnableEvents = False
Set wbSource = xlapp.Workbooks.Open("C:\test\Book2.xls")
Range("A1:A10").Value = wbSource.Sheets("Sheet1").Range

("A1:A10").Value
wbSource.Close False
xlapp.Quit
End 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:=y
ActiveSheet.PageSetup.LeftMargin= 左边距
ActiveSheet.PageSetup..PaperSize = 纸张巨细

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



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

菜单栏。当需要规复Excel 97的菜单栏时,只要删除新建设的菜单栏就可以了。该

的自界说菜单中只需两个呼吁按钮,一个用来返回到的主画面

(ReturnMAIN),另一个用来退出(ExitSYS)。下面是模块(Module)中有关

的宏或是事件节制措施。
Sub ZapMenu( )
On Error Resume Next
CommandBars(“保险查询”).Delete
End Sub
这是一个用来删除自界说菜单栏的宏。语句On Error Resume Next担保无论自

界说菜单栏是否存在都能正确删除它。
Sub ExitSYS( )
ZapMenu
ActiveWorkbook.Close SaveChanges := False
End Sub
这是用来退出的宏。它删除自界说菜单,并封锁勾当的事情簿(不提示生存

修改)。
Sub ReturnMAIN( )
Worksheets(“保险查询”).Select
End Sub
该宏用来返回主画面。它激活“保险查询”事情表。
Sub SetMenu( )
Dim myBar As CommandBar
Dim myButton As CommandBarButton
ZapMenu
Set myBar = CommandBars.Add(Name:=“保险查询”, _
Position :=msoBarTop, _
MenuBar :=True)
Set myButton = myBar.Controls.Add(msoControlButton)
myButton. = msoButtonCaption
myButton.Caption = “退出[&E]”
myButton.OnAction = “ExitSYS”
Set myButton = myBar.Controls.Add(msoControlButton)
myButton. = msoButtonCaption
myButton.Caption = “返回[&R]”
myButton.OnAction = “ReturnMAIN”
myButton.Visible = False
myBar.Protection = msoBarNoMove + msoBarNoCustomize
myBar.Visible = True
End Sub
这个宏包括五部门。第一部门界说了一对变量。第二部门首先运行ZapMenu宏,

担保保险查询菜单栏是不存在的,然后建设它。参数MenuBar的值设为True,确

保这个新建设的呼吁栏为一菜单栏。第三部门和第四部门将两个呼吁按钮插手到菜单

栏中。并配置ReturnMAIN呼吁按钮的初始状态为不行见状态。最后一部门掩护这个

新建设的菜单栏,利用户不能移动也不能自界说新菜单栏。


事情表汇总
Sub sum() '表汇总,第1张的a1:e20便是所有表的沟通单位格的和
Attribute sum.VB_ProcData.VB_Invoke_Func = "z\n14"
Dim X As Worksheet
For y = 1 To 20
For z = 1 To 5
For Each X In Worksheets
shname = X.Name
ActiveSheet.Cells(y, z).Value = ActiveSheet.Cells(y, z).Value +

Worksheets(shname).Cells(y, z)
Next
Next z
Next y
End Sub

各种Excel VBA的命令下 问题:各种Excel VBA的命令下
回答:本示例反复最近用户界面呼吁。本示例必需宏的第一行。 Application.Repeat 下例中,变量 counter 取代了行号。此将在单位格区域 C1:C20 中轮回,将所 有绝对值小于 0.01 的数字都配置为 0(零)。 Sub RoundToZero1() For Counter = 1 To 20 Set curC...
模拟“AfterPrint”事件打印后执行命令 问题:模拟“AfterPrint”事件打印后执行命令
回答:... VBA中用“Workbook.BeforePrint”事件在打印前执行某项操作或命令,那么,要在打印后再执行某个命令该如何实现呢?Excel中并没有提供“AfterPrint”事件,用下面的VBA代码可以模拟“AfterPrint”事件。 假如在“Sheet1”表的A1单元格包...
快速将VBA代码转换为注释 问题:快速将VBA代码转换为注释
回答:...大段的代码,最快捷的方式是用“编辑”工具栏中的相关命令,方法如下: 1.选择需要转换为注释的所有代码。 2.在“编辑”工具栏中单击“设置注释块”命令。如果“编辑”工具栏没有出现,则单击菜单“视图→工具栏→编...
用VBA禁止打印工作簿 问题:用VBA禁止打印工作簿
回答:...这样,当我们在该工作簿中选择“打印”或“打印预览”命令时,Excel将不会进行打印。            
用VBA将筛选后的公式批量转换为值 问题:用VBA将筛选后的公式批量转换为值
回答:...进行复制粘贴,Excel会提示“不能对多重选定区域使用此命令”。这时可用下面的VBA代码将筛选后的公式批量转换为值。 Sub ConvAfterFilter()On Error Resume NextApplication.ScreenUpdating = FalseDim Rng As RangeFor Each Rng In ActiveSheet.AutoFilter.Range.Speci...
《excel.2007宝典》[PDF] 问题:《excel.2007宝典》[PDF]
回答:...1.4.1 功能区选项卡 7 1.4.2 上下文选项卡 8 1.4.3 功能区上的命令类型 9 1.4.4 使用键盘访问功能区 10 1.5 使用快捷菜单 11 1.6 自定义快速访问工具栏 12 1.7 使用对话框 13 1.7.1 导航对话框 13 1.7.2 使用有选项卡的对话框 13 1.8 使用任务栏 1...
相关推荐: