word完整版VBA代码汇总推荐文档.docx
- 文档编号:16738434
- 上传时间:2023-07-17
- 格式:DOCX
- 页数:135
- 大小:114.92KB
word完整版VBA代码汇总推荐文档.docx
《word完整版VBA代码汇总推荐文档.docx》由会员分享,可在线阅读,更多相关《word完整版VBA代码汇总推荐文档.docx(135页珍藏版)》请在冰点文库上搜索。
word完整版VBA代码汇总推荐文档
1:
打开所有隐藏工作表
Sub 打开所有隐藏工作表()
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
End Sub
2:
循环宏
Sub 循环()
AAA = Range("C2")
Dim i As Long
Dim times As Long
times = AAA
'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)
For i = 1 To times
Call 过滤一行
If Range("完成标志") = "完成" Then
Exit For
'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出
'If Sheets("传送参数").Range("A" & i).Text = "完成" Then
Exit For
'假如某列出现"完成"内容则退出循环
Next i
End Sub
3:
录制宏时调用“停止录制”工具栏
Sub 录制宏时调用停止录制工具栏()
Application.CommandBars("Stop Recording").Visible = True
End Sub
4:
高级筛选5列不重复数据至指定表
Sub 高级筛选5列不重复数据至Sheet2()
Sheets("Sheet2").Range("A1:
E65536") = "" '清除Sheet2的A:
D列
Range("A1:
E65536").AdvancedFilter Action:
=xlFilterCopy, CopyToRange:
=Sheet2.Range( _
"A1"), Unique:
=True
Sheet2.Columns("A:
E").Sort Key1:
=Sheet2.Range("A2"), Order1:
=xlAscending, Header:
=xlGuess, _
OrderCustom:
=1, MatchCase:
=False, Orientation:
=xlTopToBottom, SortMethod _
:
=xlPinYin
End Sub
5:
双击单元执行宏(工作表代码)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Range("$A$1") = "关闭" Then
Exit Sub
Select Case Target.Address
Case "$A$4"
Call 宏1
Cancel = True
Case "$B$4"
Call 宏2
Cancel = True
Case "$C$4"
Call 宏3
Cancel = True
Case "$E$4"
Call 宏4
Cancel = True
End Select
End Sub
6:
双击指定区域单元执行宏(工作表代码)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Range("$A$1") = "关闭" Then Exit Sub
If Not Application.Intersect(Target, Range("A4:
A9", "C4:
C9")) Is Nothing Then Call 打开隐藏表
End Sub
7:
进入单元执行宏(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '以单元格进入代替按钮对象调用宏
If Range("$A$1") = "关闭" Then Exit Sub
Select Case Target.Address
Case "$A$5" '单元地址(Target.Address),或命名单元名字(Target.Name)
Call 宏1
Case "$B$5"
Call 宏2
Case "$C$5"
Call 宏3
End Select
End Sub
8:
进入指定区域单元执行宏(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("$A$1") = "关闭" Then Exit Sub
If Not Application.Intersect(Target, Range("A4:
A9","C4:
C9")) Is Nothing Then Call 打开隐藏表
End Sub
9:
在多个宏中依次循环执行一个(控件按钮代码)
Private Sub CommandButton1_Click()
Static RunMacro As Integer
Select Case RunMacro
Case 0
宏1
RunMacro = 1
Case 1
宏2
RunMacro = 2
Case 2
宏3
RunMacro = 0
End Select
End Sub
10:
在两个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "保护工作表" Then
Call 保护工作表
.Caption = "取消工作表保护"
Exit Sub
End If
If .Caption = "取消工作表保护" Then
Call 取消工作表保护
.Caption = "保护工作表"
Exit Sub
End If
End With
End Sub
11:
在三个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)
Option Explicit Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "宏1" Then
Call 宏1
.Caption = "宏2"
Exit Sub
End If
If .Caption = "宏2" Then
Call 宏2
.Caption = "宏3"
Exit Sub
End If
If .Caption = "宏3" Then
Call 宏3
.Caption = "宏1"
Exit Sub
End If
End With
End Sub
12:
根据A1单元文本隐藏/显示按钮(控件按钮代码)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") > 2 Then
CommandButton1.Visible = 1
Else
CommandButton1.Visible = 0
End If
End Sub
Private Sub CommandButton1_Click()
重排窗口
End Sub
13:
当前单元返回按钮名称(控件按钮代码)
Private Sub CommandButton1_Click()
ActiveCell = CommandButton1.Caption
End Sub
14:
当前单元内容返回到按钮名称(控件按钮代码)
Private Sub CommandButton1_Click()
CommandButton1.Caption = ActiveCell
End Sub
15:
奇偶页分别打印
Sub 奇偶页分别打印()
Dim i%, Ps%
Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数
MsgBox "现在打印奇数页,按确定开始."
For i = 1 To Ps Step 2
ActiveSheet.PrintOut from:
=i, To:
=i
Next i
MsgBox "现在打印偶数页,按确定开始."
For i = 2 To Ps Step 2
ActiveSheet.PrintOut from:
=i, To:
=i
Next i
End Sub
16:
自动打印多工作表第一页
Sub 自动打印多工作表第一页()
Dim sh As Integer
Dim x
Dim y
Dim sy
Dim syz
x = InputBox("请输入起始工作表名字:
")
sy = InputBox("请输入结束工作表名字:
")
y = Sheets(x).Index
syz = Sheets(sy).Index
For sh = y To syz
Sheets(sh).Select
Sheets(sh).PrintOut from:
=1, To:
=1
Next sh
End Sub
17:
查找A列文本循环插入分页符
Sub 循环插入分页符()
' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容
Dim i As Long
Dim times As Long
times = Application.WorksheetFunction.CountIf(Sheet1.Range("a:
a"), "分页") 'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)
For i = 1 To times
Call 插入分页符
Next i
End Sub
Sub 插入分页符()
Cells.Find(What:
="分页", After:
=ActiveCell, LookIn:
=xlValues, LookAt:
= _
xlPart, SearchOrder:
=xlByRows, SearchDirection:
=xlNext, MatchCase:
=False) _
.Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:
=ActiveCell
End Sub
Sub 取消原分页()
Cells.Select
ActiveSheet.ResetAllPageBreaks
End Sub
18:
将A列最后数据行以上的所有B列图片大小调整为所在单元大小
Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小()
Dim Pic As Picture, i&
i = [A65536].End(xlUp).Row
For Each Pic In Sheet1.Pictures
If Not Application.Intersect(Pic.TopLeftCell, Range("B1:
B" & i)) Is Nothing Then
Pic.Top = Pic.TopLeftCell.Top
Pic.Left = Pic.TopLeftCell.Left
Pic.Height = Pic.TopLeftCell.Height
Pic.Width = Pic.TopLeftCell.Width
End If
Next
End Sub
19:
返回光标所在行数
Sub 返回光标所在行数()
x = ActiveCell.Row
Range("A1") = x
End Sub
20:
在A1返回当前选中单元格数量
Sub 在A1返回当前选中单元格数量()
[A1] = Selection.Count
End Sub
21:
返回当前工作簿中工作表数量
Sub 返回当前工作簿中工作表数量()
t = Application.Sheets.Count
MsgBox t
End Sub
93:
B列录入数据时在A列返回记录时间(工作表代码)
Public Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(, -1) = Now
End If
End Sub
94:
当指定区域修改时在其右侧的2个单元返回当前日期和时间(工作表代码)
Public Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [A1:
A1000]) Is Nothing Then
If Target.Column = 1 Then
Target.Offset(, 1) = Date
Target.Offset(, 2) = Time
End If
End If
End Sub
Public Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [A1:
A1000]) Is Nothing Then
If Target.Column = 1 Then
Target.Offset(, 1) = Format(Now(), "yyyy-mm-dd")
Target.Offset(, 2) = Format(Now(), "h:
mm:
ss")
End If
End If
End Sub
95:
指定单元显示光标位置内容(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal T As Range)
Sheets
(1).Range("A1") = Selection
End Sub
96:
每编辑一个单元保存文件
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Save
End Sub
97:
指定允许编辑区域
Sub 指定允许编辑区域()
ActiveSheet.ScrollArea = "B8:
G15"
End Sub
98:
解除允许编辑区域限制
Sub 解除允许编辑区域限制()
ActiveSheet.ScrollArea = ""
End Sub
99:
删除指定行
Sub 删除指定行()
Workbooks("临时表").Sheets("表2").Range("5:
5").Delete
End Sub
100:
删除A列为指定内容的行
Sub 删除A列为指定内容的行()
Dim a, b As Integer
a = Sheet1.[a65536].End(xlUp).Row
For b = a To 2 Step -1
If Cells(b, 1).Value = "删除" Then
Rows(b).Delete
End If
Next
End Sub
ExcelVBA常用代码总结1
改变背景色
Range("A1").Interior.ColorIndex=xlNone
ColorIndex一览
∙改变文字颜色
Range("A1").Font.ColorIndex=1
∙获取单元格
Cells(1,2)
Range("H7")
∙获取范围
Range(Cells(2,3),Cells(4,5))
Range("a1:
c3")
'用快捷记号引用单元格
Worksheets("Sheet1").[A1:
B5]
∙选中某sheet
SetNewSheet=Sheets("sheet1")
NewSheet.Select
∙选中或激活某单元格
'“Range”对象的的Select方法可以选择一个或多个单元格,而Activate方法可以指定某一个单元格为活动单元格。
'下面的代码首先选择A1:
E10区域,同时激活D4单元格:
Range("a1:
e10").Select
Range("d4:
e5").Activate
'而对于下面的代码:
Range("a1:
e10").Select
Range("f11:
g15").Activate
'由于区域A1:
E10和F11:
G15没有公共区域,将最终选择F11:
G15,并激活F11单元格。
∙获得文档的路径和文件名
ActiveWorkbook.Path '路徑
ActiveWorkbook.Name '名稱
ActiveWorkbook.FullName '路徑+名稱
'或将ActiveWorkbook换成thisworkbook
∙隐藏文档
Application.Visible=False
∙禁止屏幕更新
Application.ScreenUpdating=False
∙禁止显示提示和警告消息
Application.DisplayAlerts=False
∙文件夹做成
strPath="C:
\temp\"
MkDirstrPath
∙状态栏文字表示
Application.StatusBar="计算中"
∙双击单元格内容变换
PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)
If(Target.Cells.Row>=5AndTarget.Cells.Row<=8)Then
IfTarget.Cells.Value="●"Then
Target.Cells.Value=""
Else
Target.Cells.Value="●"
EndIf
Cancel=True
EndIf
EndSub
∙文件夹选择框方法1
SetobjShell=CreateObject("Shell.Application")
SetobjFolder=objShell.BrowseForFolder(0,"文件",0,0)
IfNotobjFolderIsNothing
Thenpath=objFolder.self.Path&"\"
endif
SetobjFolder=Nothing
SetobjShell=Nothing
∙文件夹选择框方法2(推荐)
PublicFunctionChooseFolder()AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFolderPicker)
WithdlgOpen
.InitialFileName=ThisWorkbook.path&"\"
If.Show=-1Then
ChooseFolder=.SelectedItems
(1)
EndIf
EndWith
SetdlgOpen=Nothing
EndFunction
'使用方法例:
DimpathAsString
path=ChooseFolder()
Ifpath<>""Then
MsgBox"openfolder"
EndIf
∙文件选择框方法
PublicFunctionChooseOneFile(OptionalTitleStrAsString="Pleasechooseafile",OptionalTypesDecAsString="*.*",OptionalExtenAsString="*.*")AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFilePicker)
WithdlgOpen
.Title=TitleStr
.Filters.Clear
.Filters.AddTypesDec,Exten
.AllowMultiSelect=False
.InitialFileName=ThisWorkbook.Path
If.Show=-1Then
'.AllowMultiSelect=True
'ForEachvrtSelectedItemIn.SelectedItems
'MsgBox"Pathname
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- word 完整版 VBA 代码 汇总 推荐 文档
![提示](https://static.bingdoc.com/images/bang_tan.gif)