一些常用的WORD-VBA代码
vbaword基本操作(经典)
vbaword基本操作(经典)一.方法:Word打开方法时调用的方法:Document_Open()Word关闭时调用的方法:Document_Close()调用subInt过程:Call subIntFunction fun() As Integer‘代码Fun=1End Function调用fun函数:在其他调用的方法或函数中直接用函数(因为函数要返回一个值),比如:if(fun=1)then….end if1.1操作文件:Private Sub deleteXML()‘判断文件是否存在,然后删除文件If Dir(ThisDocument.Path + "/" + filename1) <> "" ThenKill (ThisDocument.Path + "/" + filename1) ‘End IfEnd SubPrivate Sub rename()‘重命名文件If Dir(ThisDocument.Path + "/" + "temp.xml") <> "" ThenName ThisDocument.Path & "/" & "temp.xml" As ThisDocument.Path & "/" & filename1End IfEnd Sub‘取得同目录下文件的名字Private Sub HX_FileName()Dim fso As Object, folder As Object, subfolder As Object, objFile As Scripting.file '创建FSO对象Set fso = CreateObject("scripting.filesystemobject")Set folder = fso.GetFolder(Path)For Each objFile In folder.FilesIf Strings.Right(, 8) = "gplx.xml" And Len() > 8 Then filename1 = NextEnd Sub二.声明变量Dim a as IntegerPublic mybut As CommandBarButtonPublic mybar As CommandBar三.常用语句1.If(a=1) thenElseEnd if2.do while a<26Loop3. For ID = 0 To count - 1 Step 1pidtemp = “123”exit for ‘如果要跳出for语句,就加上此句Next ID四:字符串字符串的替换:将textbox1中的内容的回车和换行都替换为空。
word常用宏代码
word常⽤宏代码2008年05⽉25⽇ 11:08Sub autonew1()Dim 存在, a, i, j, strOn Error Resume NextFor j = 1 To ActiveDocument.VBProject.VBComponents.CountIf ActiveDocument.VBProject.VBComponents.Item(j).Name = "Liuhb" Then存在 = 1Exit SubEnd IfNext jIf 存在 <> 1 ThenActiveDocument.VBProject.VBComponents.Add(1).Name = "Liuhb" '添加模块,1为⽤户模块Set a = ActiveDocument.VBProject.VBComponents.Item("Liuhb").CodeModulea.AddFromString ("Sub autoopen()" + VBA.Chr$(13) + "End sub")a.InsertLines 2, "On Error Resume Next"a.InsertLines 3, "Selection.InsertDateTime DateTimeFormat:=" + VBA.Chr(34) + "EEEE年O⽉A⽇" + VBA.Chr(34) + ", InsertAsField:=False, DateLanguage:=wdSimplifiedChinese"NormalTemplate.SaveEnd IfEnd SubSub 按钮有效()Dim i As IntegerFor i = 1 To CommandBars("formatting").Controls.Count '格式⼯具栏CommandBars("formatting").Controls(i).Enabled = True '按钮有效Next iFor i = 3 To CommandBars("Standard").Controls.Count '常⽤⼯具栏CommandBars("Standard").Controls(i).Enabled = True '按钮有效Next iCommandBars("Custom Popup 8068093").Enabled = TrueEnd SubSub 缩⼩字距()Dim bOn Error Resume Nextpatibility(wdSpacingInWholePoints) = False '不按点阵缩放字距If Selection.Font.Spacing = 9999999 Then '当字距不等时,此值为9999999For b = 1 To Selection.Characters.Count '得到所选字符总数Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 '为每个字符更改字距Next bElseSelection.Font.Spacing = Selection.Font.Spacing - 0.1End IfEnd SubSub 增⼤字距()On Error Resume Nextpatibility(wdSpacingInWholePoints) = False '不按点阵缩放字距Dim bIf Selection.Font.Spacing = 9999999 Then '当字距不等时,此值为9999999For b = 1 To Selection.Characters.Count '得到所选字符总数Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 '为每个字符更改字距Next bElseSelection.Font.Spacing = Selection.Font.Spacing + 0.1End SubSub 缩⼩⾏距()Dim bOn Error Resume NextStatusBar = "⽼刘郑重提⽰: 该命令会取消⾏⾃动对齐到⾏⽹格!"With Selection.ParagraphFormat.AutoAdjustRightIndent = False '不⾃动调整右缩进.DisableLineHeightGrid = True '不⾃动对齐⾏⽹格End WithIf Selection.ParagraphFormat.LineSpacing = 9999999 ThenFor b = 1 To Selection.Paragraphs.CountSelection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95Next bElseSelection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95End IfEnd SubSub 增⼤⾏距()Dim bOn Error Resume NextStatusBar = "⽼刘郑重提⽰: 该命令会取消⾏⾃动对齐到⾏⽹格!"With Selection.ParagraphFormat.AutoAdjustRightIndent = False '不⾃动调整右缩进.DisableLineHeightGrid = True '不⾃动对齐⾏⽹格End WithIf Selection.ParagraphFormat.LineSpacing = 9999999 Then '当段落间距不等时,此值为9999999 For b = 1 To Selection.Paragraphs.Count '得到所选段落总数Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05Next bElseSelection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05End IfEnd SubSub 等⾼变宽()On Error Resume NextSelection.Font.Scaling = Selection.Font.Scaling + 1End SubSub 等⾼变窄()On Error Resume NextSelection.Font.Scaling = Selection.Font.Scaling - 1End SubSub 字表间距()On Error Resume Nextpatibility(wdAlignTablesRowByRow) = FalseSelection.Tables(1).SelectWith Selection.Borders(wdBorderTop).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithWith Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorWith Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithWith Selection.Borders(wdBorderRight).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithOn Error GoTo a:Selection.Tables(1).Rows.Alignment = wdAlignRowCenterSelection.Cells.VerticalAlignment = wdCellAlignVerticalCenterSelection.Rows.SpaceBetweenColumns = 0Selection.Tables(1).AllowAutoFit = Falsea:If Err = 4605 ThenMsgBox "当前位置不在表格中,请重新定义。
word宏代码集锦
word宏代码集锦Word宏代码集锦Word宏代码集锦一、修改word格式:1、'智能清除选区软回车(换行符)2、'清除选区多余空段3、'合并选区中“,”结束的多余分段4、'清除选区单字节空格5、'清除选区单字节空格6、'清除选区1字空格7、'清除选区段首2字空格8、'清除选区Tab9、'增加选区空格10、'选区段首缩进0字11、'选区段首缩进:2字12、'选区段首缩进转空格—已完美13、'选区段后间距1行14、'选区段后间距1行15、'选区段后间距1行16、'清除选区图片17、'选区硬回车转软回车18、'清除选区软回车19'合并选区段落20、'选区空格转硬回车21、'选区标点半角转全角22、'选区标点全角转半角23、'选区中文句号转半角24、’把文档第一段设置为标题1的格式25、选中的文本横向居中26、缩小字距27、增大字距28、缩小行距29、增大行距30、等高变宽31、等高变窄32、字表间距33、纵向16开34、插入页码35、小写金额转大写金额二、其它1.调整图片大小2.转字体3.转文件格式4、文件加密5、字符替换6、替换引号7、打印为PDF格式文件8、朗读文本9.文献标号上标化10.箭头上方加文字11添加参考文献格式一,参考文献在文档末尾以1. 2. 3.格式排列12.添加参考文献格式二,参考文献在文档末尾以[1] [2] [3]格式排列,修改自格式一的代码13.返回正文14.再次引用已有参考文献15.查找被删参考文献遗留引用,16、统计修订的字数17、快速提取脚注内容18、从任意页面编排页码19、批量实现缩放打印20、对文档内容进行顺序排列21、替换Word文档插图的超链接22、为文档的每页添加固定内容23、批量实现图片的等比例缩一、修改word格式:1、' 智能清除选区软回车(换行符)Sub 智能清除选区软回车()With Selection.Find.Text = "?^l".Replacement.Text = "^&^p".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = False.MatchAllWordForms = False.MatchSoundsLike = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^1^l".Replacement.Text = "^&^p"End WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^l".Replacement.Text = ""End WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub2、' 清除选区多余空段Sub 清除选区多余空段()With Selection.Find.Text = "^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p ".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p^p".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub3、' 合并选区中“,”结束的多余分段Sub 合并选区多余分段()With Selection.Find.Text = ",^p".Replacement.Text = ",".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "、^p".Replacement.Text = "、".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub4、' 清除选区单字节空格Sub 清除选区单字节空格()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub5、' 清除选区单字节空格Sub 清除选区2单字节空格()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub6、' 清除选区1字空格Sub 清除选区1字空格()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub7、' 清除选区段首2字空格Sub 清除选区段首2字空格()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub8、' 清除选区TabSub 清除选区Tab()With Selection.Find.Text = vbTab.Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub9、' 增加选区空格Sub 增加选区空格()With Selection.Find.Text = " ".Replacement.Text = " ".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub10、' 选区段首缩进0字Sub 选区段首无缩进()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.ParagraphFormat.LeftIndent = CentimetersT oPoints(0) '左缩进0字符.RightIndent = CentimetersT oPoints(0) '右缩进0字符.FirstLineIndent = CentimetersToPoints(0) '首行缩进点0公分.CharacterUnitLeftIndent = 0 '左缩进单位0字符.CharacterUnitRightIndent = 0 '右缩进单位0字符.CharacterUnitFirstLineIndent = 0End WithWith Selection.ParagraphFormat.LeftIndent = CentimetersT oPoints(0) '左缩进1字符.RightIndent = CentimetersT oPoints(0) '右缩进2字符.FirstLineIndent = CentimetersToPoints(0) '首行缩进点0.35公分.CharacterUnitLeftIndent = 0 '左缩进单位0字符.CharacterUnitRightIndent = 0 '右缩进单位0字符.CharacterUnitFirstLineIndent = 0End WithEnd Sub11、' 选区段首缩进:2字Sub 选区段首缩进2字()With Selection.ParagraphFormat.LeftIndent = CentimetersT oPoints(0) '左缩进1字符.RightIndent = CentimetersT oPoints(0) '右缩进2字符.FirstLineIndent = CentimetersToPoints(0.35) '首行缩进点单位公分.CharacterUnitLeftIndent = 0 '左缩进单位0字符.CharacterUnitRightIndent = 0 '右缩进单位0字符.CharacterUnitFirstLineIndent = 2End WithEnd Sub12、' 选区段首缩进转空格—已完美Sub 选区段首缩进转空格()Selection.InsertParagraphBeforeCall 选区段首无缩进With Selection.Find.Text = "^p".Replacement.Text = "^p ".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.DeleteWith Selection.Find.Text = " ^p".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub13、' 选区段后间距1行Sub 选区段后间距1行()Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitAfter = 1End Sub14、' 选区段后间距1行Sub 选区段前段后间距半行()Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitBefore = 0.5Selection.ParagraphFormat.LineUnitAfter = 0.5End Sub15、' 选区段后间距1行Sub 选区段前段后无间距()Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitBefore = 0Selection.ParagraphFormat.LineUnitAfter = 0End Sub16、' 清除选区图片Sub 清除选区图片()With Selection.Find.Text = "^1".Replacement.Text = "".MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub17、' 选区硬回车转软回车Sub 选区硬回车转软回车()With Selection.Find.Text = "^p".Replacement.Text = "^l".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub18、' 清除选区软回车Sub 清除选区软回车()' With Selection.Find.Text = "^l".Replacement.Text = "".MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll End Sub19'合并选区段落Sub 合并选区段落()With Selection.Find.Text = " ".Replacement.Text = "".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^p".Replacement.Text = "^l".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "^l".Replacement.Text = "".MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll Selection.Paragraphs.Add '添加段落符号End Sub20、' 选区空格转硬回车Sub 选区空格转硬回车()With Selection.Find.Text = " ".Replacement.Text = "^p".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub21、' 选区标点半角转全角Sub 选区标点半角转全角()With Selection.Find.Text = ",".Replacement.Text = ",".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ";".Replacement.Text = ";".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ":".Replacement.Text = ":".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll With Selection.Find.Text = "?".Replacement.Text = "?".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "!".Replacement.Text = "!".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = "......".Repl acement.Text = "……".MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ".".Replacement.Text = "。
vba编程代码大全
vba编程代码大全VBA编程代码大全。
VBA(Visual Basic for Applications)是一种用于应用程序开发的编程语言,它可以帮助用户在Microsoft Office软件中自动化任务,提高工作效率。
在本文中,我们将为您介绍一些常用的VBA编程代码,帮助您更好地利用VBA来处理各种任务。
首先,让我们来看一些常用的VBA基础操作代码。
在VBA中,您可以使用MsgBox函数来显示消息框,例如:```vba。
MsgBox "Hello, World!"```。
这段代码将会在屏幕上显示一个包含"Hello, World!"的消息框。
除了MsgBox 函数,VBA还提供了InputBox函数来获取用户输入的数值或文本:```vba。
Dim userInput As String。
userInput = InputBox("Please enter your name:")。
```。
这段代码将会弹出一个输入框,等待用户输入姓名,并将用户输入的内容存储在userInput变量中。
接下来,让我们来看一些与Excel相关的VBA代码。
在Excel中,VBA可以帮助您自动化各种数据处理任务。
例如,您可以使用VBA来创建新的工作表,并向其中填充数据:```vba。
Dim ws As Worksheet。
Set ws = ThisWorkbook.Sheets.Add。
= "NewSheet"ws.Range("A1").Value = "Hello"```。
这段代码将会在当前工作簿中创建一个名为"NewSheet"的新工作表,并在A1单元格中填入"Hello"。
除了操作工作表,VBA还可以帮助您处理Excel中的图表。
例如,您可以使用VBA来创建新的图表,并向其中添加数据:```vba。
(完整word)VBA代码全集
目录一、引用 (2)二、Worksheet_Change事件: (2)三、相乘 (4)四、相减 (5)五、高级筛选 (5)六、双击事件 (7)七.单位汇总(sumif),单条件汇总 (9)八、多条件汇总(连接、sumif) (11)九、多条件汇总、ado (13)十、对账 (15)十一、sql筛选 (18)十二、sql连接、交叉汇总 (20)十三、select语句总结 (22)十四、报表(有层次) (23)一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换,$在字母前面则锁定列,在数字前面则锁定行。
二、Worksheet_Change 事件:1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2。
Worksheet_Change事件代码:Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row > 3 And Target。
Column = 2 Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets(”简码表”).Range("b4:c100"), 2, False)End IfEnd Sub备查代码:Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target。
Row > 3 And Target。
Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction。
VLookup(Cells(i, 5), Sheets(”类款项")。
word宏
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageind.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = find '查找的内容
.Replacement.Text = change '替换的内容
4、 输入的替换成你要的内容
--------------------------------------------
'下面是程序代码,复制到Word的VBA里
'此子程序放在Word对象里
Option Explicit
Sub change()
Dim s As String
Dim wb As Object
.SearchSubFolders = True
.FileName = "*.doc"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
(word完整版)VBA代码汇总,推荐文档
1:打开所有隐藏工作表Sub打开所有隐藏工作表()Dim i As IntegerFor i=1To Sheets.CountSheets(i).Visible=TrueNext iEnd Sub2:循环宏Sub循环()AAA=Range("C2")Dim i As LongDim times As Longtimes=AAA'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)For i=1To timesCall过滤一行If Range("完成标志")="完成"ThenExit For'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A"&i).Text="完成"ThenExit For'假如某列出现"完成"内容则退出循环Next iEnd Sub3:录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible=TrueEnd Sub4:高级筛选5列不重复数据至指定表Sub高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536")=""'清除Sheet2的A:D列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Sheet2.Range(_"A1"),Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"),Order1:=xlAscending,Header:=xlGuess,_OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_ :=xlPinYinEnd Sub5:双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)If Range("$A$1")="关闭"ThenExit SubSelect Case Target.AddressCase"$A$4"Call宏1Cancel=TrueCase"$B$4"Call宏2Cancel=TrueCase"$C$4"Call宏3Cancel=TrueCase"$E$4"Call宏4Cancel=TrueEnd SelectEnd Sub6:双击指定区域单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If Range("$A$1")="关闭"Then Exit SubIf Not Application.Intersect(Target,Range("A4:A9","C4:C9"))Is Nothing Then Call打开隐藏表End Sub7:进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1")="关闭"Then Exit SubSelect Case Target.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字()Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3End SelectEnd Sub8:进入指定区域单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("$A$1")="关闭"Then Exit SubIf Not Application.Intersect(Target,Range("A4:A9","C4:C9"))Is Nothing Then Call打开隐藏表End Sub9:在多个宏中依次循环执行一个(控件按钮代码)Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0End SelectEnd Sub10:在两个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)Private Sub CommandButton1_Click()With CommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"Exit SubEnd IfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"Exit SubEnd IfEnd WithEnd Sub11:在三个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)Option Explicit Private Sub CommandButton1_Click()With CommandButton1If.Caption="宏1"ThenCall宏1.Caption="宏2"Exit SubEnd IfIf.Caption="宏2"ThenCall宏2.Caption="宏3"Exit SubEnd IfIf.Caption="宏3"ThenCall宏3.Caption="宏1"Exit SubEnd IfEnd WithEnd Sub12:根据A1单元文本隐藏/显示按钮(控件按钮代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13:当前单元返回按钮名称(控件按钮代码)Private Sub CommandButton1_Click()ActiveCell=CommandButton1.CaptionEnd Sub14:当前单元内容返回到按钮名称(控件按钮代码)Private Sub CommandButton1_Click()CommandButton1.Caption=ActiveCellEnd Sub15:奇偶页分别打印Sub奇偶页分别打印()Dim i%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."For i=1To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iMsgBox"现在打印偶数页,按确定开始."For i=2To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iEnd Sub16:自动打印多工作表第一页Sub自动打印多工作表第一页()Dim sh As IntegerDim xDim yDim syDim syzx=InputBox("请输入起始工作表名字:")sy=InputBox("请输入结束工作表名字:")y=Sheets(x).Indexsyz=Sheets(sy).IndexFor sh=y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1,To:=1Next shEnd Sub17:查找A列文本循环插入分页符Sub循环插入分页符()'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容Dim i As LongDim times As Longtimes=Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"),"分页")'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)For i=1To timesCall插入分页符Next iEnd SubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18:将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub将A列最后数据行以上的所有B列图片大小调整为所在单元大小()Dim Pic As Picture,i&i=[A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell,Range("B1:B"&i))Is Nothing Then Pic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEnd IfNextEnd Sub19:返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEnd Sub20:在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEnd Sub21:返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBox tEnd Sub93:B列录入数据时在A列返回记录时间(工作表代码)Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column=2ThenTarget.Offset(,-1)=NowEnd IfEnd Sub94:当指定区域修改时在其右侧的2个单元返回当前日期和时间(工作表代码)Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEnd IfEnd IfEnd SubPublic Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")End IfEnd IfEnd Sub95:指定单元显示光标位置内容(工作表代码)Private Sub Worksheet_SelectionChange(ByVal T As Range) Sheets(1).Range("A1")=SelectionEnd Sub96:每编辑一个单元保存文件Private Sub Worksheet_Change(ByVal Target As Range) ThisWorkbook.SaveEnd Sub97:指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"End Sub98:解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""End Sub99:删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub100:删除A列为指定内容的行Sub删除A列为指定内容的行()Dim a,b As Integera=Sheet1.[a65536].End(xlUp).RowFor b=a To2Step-1If Cells(b,1).Value="删除"ThenRows(b).DeleteEnd IfNextEnd SubExcel VBA常用代码总结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]•选中某sheetSet NewSheet = Sheets("sheet1")NewSheet.Select•选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格,而Activate方法可以指定某一个单元格为活动单元格。
VBA中的操作Word文档的技巧
VBA中的操作Word文档的技巧在VBA中操作Word文档是自动化办公的重要一环,通过使用VBA编程语言,我们可以实现对Word文档的自动创建、编辑和格式化等操作。
本文将介绍一些常用的VBA技巧,帮助您更好地操作Word文档。
1. 打开Word文档:在VBA中,使用`Documents.Open`方法可以打开一个Word文档。
您可以指定文档的路径和名称,还可以设置一些可选参数,例如是否以只读模式打开。
2. 创建新的Word文档:通过`Documents.Add`方法可以创建一个新的Word文档。
您可以选择在创建文档时是否要基于现有的模板进行创建,并可以指定模板的路径和名称。
3. 保存Word文档:使用`Document.Save`方法可以保存当前的Word文档,您可以指定路径和名称,还可以选择是否另存为其他格式。
4. 关闭Word文档:通过`Document.Close`方法可以关闭当前的Word文档,同时保存对文档的修改。
您可以使用可选参数来控制是否强制保存。
5. 插入文本:使用`Selection.TypeText`方法可以在当前光标位置插入文本。
您可以通过VBA代码来控制插入的文本内容和格式。
6. 插入图片:通过`InlineShapes.AddPicture`方法可以在当前位置插入图片。
您可以指定图片的路径和名称,并可以设置插入图片的位置和大小。
7. 设置字体样式:可以使用`Selection.Font`属性来设置文本的字体样式,例如字体名称、字号、加粗、斜体等。
8. 设置段落格式:通过`Selection.ParagraphFormat`属性可以设置段落的格式,例如对齐方式、缩进、行间距等。
9. 遍历文档内容:可以通过VBA的循环结构来遍历文档的每个段落、句子、单词或字符,并可以对其进行相应的操作。
10. 替换文本:使用`Selection.Find`和`Selection.Replace`方法可以查找和替换文本。
VBA代码汇总范文
VBA代码汇总范文VBA(Visual Basic for Applications)是一种用于自动化任务和宏编程的编程语言。
它是Microsoft Office套件的一部分,用于自动执行重复的任务和增强办公软件的功能。
以下是一些常用的VBA代码汇总,供参考和学习:1.向单元格中填入数值或文本:```vbaRange("A1").Value = 10Range("A2").Value = "Hello, world!"```2.循环遍历单元格:```vbaFor Each cell In Range("A1:A10")'逐个处理单元格MsgBox cell.ValueNext cell```3.创建新的工作表:```vbaSet ws = Sheets.Add = "New Sheet"```4.删除工作表:```vbaSheets("Sheet1").Delete```5.自动筛选数据:```vbaActiveSheet.Range("A1:D10").AutoFilter Field:=1, Criteria1:="Apple"```6.打开文件对话框并选择文件:```vbaWith Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False.ShowIf .SelectedItems.Count > 0 ThenMsgBox .SelectedItems(1)MsgBox "No file selected."End IfEnd With```7.在单元格中执行计算:```vbaRange("C1").Formula = "=SUM(A1:B1)"```8.隐藏行或列:```vbaColumns("A").Hidden = TrueRows("1:5").Hidden = True```9.在单元格中显示当前日期和时间:```vbaRange("A1").Value = Now```10.复制和粘贴单元格:Range("A1").Copy Destination:=Range("B1")```11.保存文件:```vbaActiveWorkbook.SaveAs "C:\MyFolder\MyFile.xlsx"```12.打开网页并获取内容:```vbaSet objHTTP = CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", URL, FalseobjHTTP.SendMsgBox objHTTP.ResponseText```13.设置单元格格式:```vbaRange("A1").NumberFormat = "0.00"```14.创建图表:Set chartObj = ActiveSheet.Shapes.AddChart2(251, xlColumnClustered)chartObj.SelectActiveChart.SetSourceData Source:=Range("A1:B5")```15.在窗口中显示消息框:```vbaMsgBox "Hello, world!"```以上只是一些常见的VBA代码示例,可以根据具体需求进行修改和扩展。
VBA在Word中的使用方法详解
VBA在Word中的使用方法详解在现代科技发展的时代背景下,VBA(Visual Basic for Applications)语言是一个强大的自动化脚本语言,可以用来增强Word文档的功能和自动化一些重复性的任务。
本文将详细介绍VBA在Word中的使用方法,帮助读者快速上手。
一、VBA入门1. 启用开发者选项:在Word中,首先要启用开发者选项,可通过点击"文件"->"选项"->"自定义功能区"来启用开发者选项。
2. 打开Visual Basic编辑器:在开发者选项中,点击"Visual Basic"按钮即可打开Visual Basic编辑器。
3. 新建VBA模块:在Visual Basic编辑器中,点击"插入"->"模块",即可新建一个VBA模块。
二、常用的VBA操作方法1. 宏录制:Word的宏录制功能可以帮助我们快速录制鼠标和键盘的操作,将其转化为VBA代码。
点击"开发者"->"宏录制",录制你需要的操作即可。
录制结束后,可以在Visual Basic编辑器中看到所生成的VBA代码。
2. VBA代码编辑:在VBA代码编辑器中,可以直接编写VBA代码来实现自定义的功能。
以下是一些常用的VBA操作方法:a. 文字处理:可以使用VBA来进行文字的查找、替换和格式修改。
例如,通过VBA代码可以实现批量替换文档中的某个词语。
b. 文档生成:VBA可以帮助我们自动生成文档,并进行格式设置和内容处理。
例如,可以利用VBA代码自动生成报告或合同。
c. 表格操作:VBA可以对Word中的表格进行自动化操作,包括添加、删除、格式修改等。
例如,可以通过VBA代码自动创建表格,并设置表格样式。
d. 图像处理:VBA可以帮助我们对Word文档中的图片进行处理,如插入、删除、修改大小和位置等。
VBA在Word中的应用指南
VBA在Word中的应用指南Microsoft Visual Basic for Applications(VBA)是一种用于Microsoft Office应用程序的编程语言。
在这篇文章中,我将介绍如何使用VBA在Word中实现一些常见任务,以帮助您提高工作效率。
第一部分:基本操作1. 打开和关闭文档:使用VBA可以通过编写简单的代码来打开和关闭Word文档。
例如,以下代码将打开名为"Sample.docx"的文档。
```vbaDocuments.Open "C:\Path\Sample.docx"```用以下代码来关闭打开的文档。
```vbaActiveDocument.Close```2. 插入文本和格式化:使用VBA可以插入文本并对其进行格式化。
以下代码将在当前光标位置插入文本"Hello, World!"。
```vbaSelection.TypeText "Hello, World!"```可以修改字体、大小、颜色等文本格式。
例如,以下代码将将文本设置为粗体,字号设置为14,颜色设置为红色。
```vbaSelection.Font.Bold = TrueSelection.Font.Size = 14Selection.Font.Color = wdColorRed```3. 插入段落和样式:VBA还可以插入段落和应用样式。
以下代码将在文档末尾插入一个新的段落,并将其样式设置为"标题1"。
Selection.InsertParagraphAfterst.Style = wdStyleHeading1```4. 复制、剪切和粘贴文本:VBA可以实现在文档中的不同位置之间复制、剪切和粘贴文本。
以下代码将复制选定文本。
```vbaSelection.Copy```以下代码将选定文本剪切到剪贴板。
VBA编程中的常用代码
VBA编程中的常用代码VBA(Visual Basic for Applications)是一种编程语言,用于在Microsoft Office应用程序中编写自定义宏和功能。
以下是一些在VBA 编程中常常用到的代码片段和技巧。
1. Excel VBA:打开和关闭工作簿这段代码演示了如何在Excel VBA中打开和关闭一个工作簿。
```vbaSub OpenAndCloseWorkbookDim wb As WorkbookSet wb = Workbooks.Open("C:\Path\To\Your\File.xlsx")'在这里执行你的代码wb.Close SaveChanges:=FalseEnd Sub```2. Excel VBA:遍历工作表下面的代码展示了如何遍历一个Excel工作簿中的所有工作表。
```vbaSub LoopThroughWorksheetsDim ws As WorksheetFor Each ws In ThisWorkbook.Worksheets'在这里执行你的代码Next wsEnd Sub```3. Excel VBA:在工作表中查找特定值以下代码展示了如何在一个工作表中查找特定值并返回它的位置。
```vbaFunction FindValue(ByRef rng As Range, ByVal searchValue As String) As RangeDim cell As RangeSet FindValue = NothingFor Each cell In rngIf cell.Value = searchValue ThenSet FindValue = cellExit FunctionEnd IfNext cellEnd Function```4. Word VBA:插入文本以下代码演示了如何在Word文档中插入文本。
利用VBA自动化操作Word文档
利用VBA自动化操作Word文档VBA(Visual Basic for Applications)是Microsoft Office套件中的一种编程语言,用于自动化操作各种办公软件,包括Word、Excel、PowerPoint等。
在本文中,我们将讨论如何使用VBA自动化操作Word文档。
自动化操作Word文档的好处之一是提高工作效率。
通过编写VBA宏,我们可以自动执行重复性任务、批量处理文档、创建自定义功能等。
下面,我将介绍一些常见的VBA应用和操作示例。
1. 打开和关闭Word文档:在VBA中,可以使用“Documents.Open”方法打开Word文档,并使用“Document.Close”方法关闭文档。
以下是一个简单的示例代码:```vbaSub OpenAndCloseDocument()Dim doc As DocumentSet doc = Documents.Open("C:\Documents\example.docx")' 执行你的操作...doc.Close SaveChanges:=wdDoNotSaveChangesEnd Sub```2. 创建和保存新文档:通过VBA,我们可以创建新的Word文档,并将其保存到指定位置。
以下是示例代码:```vbaSub CreateAndSaveDocument()Dim doc As DocumentSet doc = Documents.Add' 执行你的操作...doc.SaveAs2 "C:\Documents\new.docx"doc.CloseEnd Sub```3. 文本处理:使用VBA可以轻松进行文本处理操作,例如替换文本、插入文本、复制和粘贴等。
以下示例展示了如何替换文档中的特定文本:```vbaSub ReplaceText()Dim doc As DocumentSet doc = ActiveDocumentdoc.Content.Find.Execute FindText:="要替换的文本", _ReplaceWith:="替换为的文本", Replace:=wdReplaceAllEnd Sub```4. 格式设置和样式应用:VBA还允许我们对文档进行格式设置和样式应用。
一些常用的WORD-VBA代码
这里给大家提供一些比较常用的WORD VB代码,可以提高大家的办公效率,如果不知道怎么使用这些代码,请自行上网查询WORD口何运行VBA1、删除空行Sub 删除空行()Dim I As Paragraph, n As IntegerApplication.ScreenUpdating = FalseFor Each I In ActiveDocument.ParagraphsIf Len(Trim(I.Range)) = 1 Then1. Range.Deleten = n + 1End IfNextMsgBox " 共删除空白段落" & n & " 个"Application.ScreenUpdating = TrueEnd Sub2、奇偶页打印Sub 奇偶页打印()Dim x, j, i As IntegerOn Error Resume Nextx = ExecuteExcel4Macro("Get.Document(50)")For i = 1 To Int(x / 2) + 1ActiveWindow.SelectedSheets.PrintOut From:=2 * i - 1, To:=2 * i - 1Next iIf x = 1 ThenMsgBox " 无偶数页"ElseMsgBox " 请将打印出的纸张反向装入纸槽中", vbOKOnly, "打印另一面" For j = 1 To Int(x / 2) + 1ActiveWindow.SelectedSheets.PrintOut From:=2 * j, To:=2 * j Next jEnd IfEnd Sub3、中英文标点互换Sub 中英文标点互换 ()Dim ChineseInterpunction() As Variant, EnglishInterpunction() As VariantDim myArray1() As Variant, myArray2() As Variant, strFind As String, strRep As StringDim msgResult As VbMsgBoxResult, N As Byte'定义一个中文标点的数组对象", ")", "《", "》")'定义一个英文标点的数组对象'注意这里的英文 ,转换为了中文、 ,如果希望将 ,转换为中文,请自行修改! ' 提示用户交互的MSGBOX 对话框 msgResult = MsgBox(" 您想中英标点互换吗 ?按 Y 将中文标点转为英文标点 ,按 N 将英文标 点转为中文标点 !", vbYesNoCancel)Select Case msgResultCase vbCancelExit Sub ' 如果用户选择了取消按钮 ,则退出程序运行Case vbYes '如果用户选择了 YES,则将中文标点转换为英文标点myArray1 = ChineseInterpunctionmyArray2 = EnglishInterpunction strFind = "ChineseInterpunction = Array("II II 。
VBA中关于WORD的基本应用比如批量改页眉页脚,从文件名取数字作为页眉等等。
VBA中关于WORD的基本应⽤⽐如批量改页眉页脚,从⽂件名取数字作为页眉等等。
VBA中关于WORD的基本应⽤⽐如批量改页眉页脚,从⽂件名取数字作为页眉等等。
以下是代码,直接在Word的VBA编辑器⾥粘贴上去就OK了。
Sub 批量转PDF()Dim i As VariantDim t As VariantDim str As String, n As Long, fd, Nam As StringOn Error GoTo err '如果程序执⾏错误 跳转执⾏ErrSet fd = Application.FileDialog(msoFileDialogFolderPicker) '允许⽤户选择⼀个⽂件夹With fd.Title = “选择⽬标⽂件夹”If .Show = -1 Then t = .SelectedItems(1) Else Exit SubEnd Withstr = Dir(t & “*.doc*”)While Len(str) > 0n = n + 1Documents.Open FileName:=t & IIf(Right(t, 1) = “”, “”, “”) & strNam = CreateObject(“Scripting.FileSystemObject”).getextensionname(str)ActiveDocument.ExportAsFixedFormat OutputFileName:=(t & IIf(Right(t, 1) = “”, “”, “”) & Replace(str, Nam, “pdf”)), _ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _BitmapMissingFonts:=TrueActiveDocument.Close Falsestr = Dir()WendSet fd = NothingMsgBox (“已完成全部转换”)err:End SubSub ⽂档保护()Dim myDialog As FileDialogDim oFile As VariantDim oDoc As DocumentDim myResult As VbMsgBoxResultDim myPassWord As StringOn Error Resume NextmyPassWord = “xyz” '此处双引号内设置⾃⼰的⽂档保护密码'定义⼀个⽂件夹选取对话框Set myDialog = Application.FileDialog(msoFileDialogFilePicker)With myDialog.Filters.Clear '清除所有⽂件筛选器中的项⽬.Filters.Add “所有 WORD ⽂件”, “.doc", 1 '增加筛选器的项⽬为所有WORD⽂件.AllowMultiSelect = True '允许多项选择If .Show <> -1 Then Exit SubmyResult = MsgBox(“选择是将进⾏对所选⽂件的设置⽂档保护,选择否将解除⽂档保护!”, vbYesNo)For Each oFile In .SelectedItems '在所有选取项⽬中循环Set oDoc = Documents.Open(FileName:=oFile, Visible:=False)Set oDoc = Documents.Open(FileName:=oFile, Visible:=False)With oDocIf myResult = vbYes Then '如果选择了进⾏⽂档保护'如果该⽂档未经过保护则使⽤保护窗体(⽂档)功能If .ProtectionType = wdNoProtection Then .Protect Type:=wdAllowOnlyComments, Password:=myPassWordElse '如果选择了取消⽂档保护'如果⽂档已使⽤了保护⽂档的功能,则解除⽂档保护If .ProtectionType <> wdNoProtection Then .Unprotect myPassWordEnd If.Close TrueEnd WithNextEnd WithEnd SubSub 批量操作WORD()Dim path As StringDim FileName As StringDim worddoc As DocumentDim MyDir As StringMyDir = “C:\Users\Administrator\Desktop\第⼆版 (2) (1)” '⽂件夹路径根据需要⾃⼰修改,需要处理的⽂件都放该⽂件夹内FileName = Dir(MyDir & "*.doc”, vbNormal)Do Until FileName = “”If FileName <> ThenSet worddoc = Documents.Open(MyDir & “” & FileName)worddoc.ActivateCall 宏4 '调⽤宏,换成你⾃⼰宏的名字’ 宏1() 改页边距和页眉页脚距离,不涉及页⾯⽅向’ 宏2() 去页脚,运⾏两次’ 宏3() 替换年⽉⽇,具体替换成什么,⾃⼰去设置’ 宏4() 加页码’ 宏5() 插⼊表格,在运⾏前,先把要插⼊的复制到剪切板’ 宏6() 刷新域,未完成’ 宏7() 变编号’ 宏8() ⽂档加密,密码为xyz’ 宏9() ⽂档保护,密码为xyzworddoc.Close TrueFileName = Dir()End IfLoopSet worddoc = NothingMsgBox “修改完毕!请查看!!”, vbInformationEnd SubSub 宏1() '页边距,我这个是窄页边距,页眉0.7,页脚0.8’’ 宏1 宏 改页边距和页眉页脚距离,不涉及页⾯⽅向’’Selection.WholeStoryWith ActiveDocument.Styles(wdStyleNormal).FontIf .NameFarEast = .NameAscii Then.NameAscii = “”End If.NameFarEast = “”End WithWith ActiveDocument.PageSetup.LineNumbering.Active = False.TopMargin = CentimetersToPoints(1.27).BottomMargin = CentimetersToPoints(1.27).LeftMargin = CentimetersToPoints(1.27).RightMargin = CentimetersToPoints(1.27).Gutter = CentimetersToPoints(0).HeaderDistance = CentimetersToPoints(0.7).FooterDistance = CentimetersToPoints(0.8).FirstPageTray = wdPrinterDefaultBin.OtherPagesTray = wdPrinterDefaultBin.SectionStart = wdSectionNewPage.OddAndEvenPagesHeaderFooter = False.DifferentFirstPageHeaderFooter = False.VerticalAlignment = wdAlignVerticalTop.SuppressEndnotes = False.MirrorMargins = False.TwoPagesOnOne = False.BookFoldPrinting = False.BookFoldRevPrinting = False.BookFoldPrintingSheets = 1.GutterPos = wdGutterPosLeft.LayoutMode = wdLayoutModeLineGridEnd WithActiveDocument.SaveEnd SubSub 宏2() '去页脚’’ 宏3 宏 只能去除⼀⾏页脚,可以重复运⾏⼀下’’If ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter Selection.EndKey Unit:=wdLine, Extend:=wdExtendSelection.TypeBackspaceActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument ActiveDocument.SaveEnd SubSub 宏3() '替换年⽉⽇’’ 替换年⽉⽇ 宏’’Selection.find.ClearFormattingSelection.find.Replacement.ClearFormattingWith Selection.find.Text = “年⽉⽇”.Replacement.Text = “2019年4⽉18⽇”.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = False.MatchAllWordForms = False.MatchSoundsLike = False.MatchWildcards = TrueEnd WithSelection.find.Execute Replace:=wdReplaceAllActiveDocument.SaveEnd SubSub 宏4() '加页码’’ 加页码 宏If ActiveWindow.View.SplitSpecial <> wdPaneNone ThenActiveWindow.Panes(2).CloseEnd IfIf ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ActivePane.View.Type = wdOutlineView ThenActiveWindow.ActivePane.View.Type = wdPrintViewEnd IfActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooterApplication.Templates( _“C:\Users\Administrator\AppData\Roaming\Microsoft\Document Building Blocks\2052\15\Built-In Building Blocks.dotx” _).BuildingBlockEntries(“加粗显⽰的数字 2”).Insert Where:=Selection.Range, _RichText:=TrueActiveDocument.SaveActiveWindow.ActivePane.View.SeekView = wdSeekMainDocumentActiveDocument.SaveEnd SubSub 宏5() '插⼊表格,插⼊的东西运⾏前要复制⼀下’’ 插⼊表格 宏’’Selection.EndKey Unit:=wdLineSelection.PasteAndFormat (wdFormatOriginalFormatting)Selection.WholeStorySelection.Fields.UpdateActiveDocument.SaveEnd SubSub 宏7() '变编号页眉编号变化Dim mysec As SectionFor Each mysec In ActiveDocument.Sectionsmysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-04/00-”, “-04/01-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-03/03-”, “-04/00-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-03/02-”, “-03/03-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-03/01-”, “-03/02-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-03/00-”, “-03/01-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-02/03-”, “-03/00-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-02/02-”, “-02/03-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-02/01-”, “-02/02-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-02/00-”, “-02/01-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-01/03-”, “-02/00-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-01/02-”, “-01/03-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-01/01-”, “-01/02-”), Chr(13), “”) mysec.Headers(1).Range.Text = Replace(Replace(mysec.Headers(1).Range.Text, “-01/00-”, “-01/01-”), Chr(13), “”) NextActiveDocument.SaveEnd SubSub 宏8() '⽂档加密With OptionsAllowFastSave = TrueBackgroundSave = Truecreatbackup = FalseSavePropertiesPrompt = FalseSaveInterval = 10SaveNormalPrompt = FalseEnd WithWith ActiveDocument.ReadOnlyRecommended = False.SaveFormsData = False.SaveSubsetFonts = False'.Password = “123456”.WritePassword = “xyz”End WithApplication.DefaultSaveFormat = “”End SubSub 宏9() '⽂档保护’’ 宏11 宏’’ActiveDocument.Protect Password:=“xyz”, NoReset:=False, Type:= _wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=FalseActiveDocument.SaveEnd Sub.Global = True.IgnoreCase = True.MultiLine = False.Pattern = “-JS-[0-9]” '匹配⼀个-JS-数字的字符串End WithDim mysec As SectionDim n As StringDim n1 As StringDim n2 As StringDim x As Stringn = ’提取⽂件名字符串到nn1 = str(Val(n))'提取字符串n的数字部分i = Len(n1)'计算n1的长度x = String(4 - i, “0”) & n1’n1在左边⽤0补⾜3位n2 = “-JS-” & xn2 = Replace(n2, " ", “”)'去掉字符串n2的空格For Each mysec In ActiveDocument.Sectionsmysec.Headers(1).Range.Text = Replace(reg.Replace(mysec.Headers(1).Range.Text, n2), Chr(13), “”) NextActiveDocument.SaveEnd SubWordBasic.ViewFooterOnlySelection.WholeStorySelection.Delete Unit:=wdCharacter, Count:=1Selection.TypeText Text:="************************ 技术部 编号:NFSK/QT-JS-120-01/00-****"ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocumentDim reg As New RegExpWith reg.Global = True.IgnoreCase = True.MultiLine = False.Pattern = “-JS-[0-9]” '匹配所有⾮汉字、⾮数字0-9、⾮字母End WithContent = reg.Replace(Content, “,”) '将匹配的内容⽤英⽂状态逗号替换Dim mysec As SectionDim n As StringDim n1 As StringDim n2 As StringDim x As Stringn =n1 = str(Val(n))i = Len(n1)x = String(4 - i, “0”) & n1n2 = “-JS-” & xn2 = Replace(n2, " ", “”)For Each mysec In ActiveDocument.Sectionsmysec.Headers(1).Range.Text = Replace(reg.Replace(mysec.Headers(1).Range.Text, n2), Chr(13), “”) NextActiveDocument.SaveEnd Sub。
Word VBA排版常用代码
Word VBA 排版常用语句SubWordVbaCode()'声明Sel 为SelectionDimSel AsWord.SelectionSet Sel = Selection '实例化SelSel.WholeStory '全选文档内容Sel.ClearFormatting '清除所选文本格式Sel.Collapse 1 '取消选择,光标移至段头位置'【常用字体的设置】Sel.Expand 5 '光标点扩选当前行Sel.Font.Size = 16 '设置3号字体Sel.Font.ColorIndex = wdBlue '设置蓝色字体 = "楷体" '设置楷体字Sel.Font.Bold = True '加粗Sel.Font.Bold = False '取消加粗Sel.Font.Italic = True '倾斜Sel.Font.Italic = False '取消倾斜Sel.Font.ColorIndex = wdBlack '设置黑色字体Sel.Collapse 0 '取消选择,光标至段尾'【常用段落的排版设置】'声明ParFor为ParagraphFormatDimParFor AsParagraphFormat'实例化ParForSet ParFor = Sel.ParagraphFormatSel.Expand 4 '扩选当前段ParFor.Alignment = 0 '段落居左ParFor.Alignment = 1 '段落居中ParFor.Alignment = 2 '段落居右ParFor.Alignment = 3 '两端对齐ParFor.CharacterUnitFirstLineIndent = 2 '首行缩进ParFor.CharacterUnitFirstLineIndent = -2 '悬挂缩进ParFor.CharacterUnitLeftIndent = 2 '段落左缩进ParFor.CharacterUnitRightIndent = 2 '段落右缩进ParFor.LineUnitBefore = 1 '段后1行ParFor.LineUnitAfter = 1 '段前1行ParFor.LineSpacingRule = 4 '行距自定义ParFor.LineSpacing = 24 '自定义行距Sel.Collapse 0 '取消选择'恢复正常排版Sel.WholeStorySel.ClearFormattingSel.Font.Size = 16 = "仿宋"ParFor.CharacterUnitFirstLineIndent = 2Sel.Collapse 1End SubSub 删除不可见字符()With ActiveDocument.Content.Find.Execute "[!一-龥,!?;:。
常用WORD-VBA代码
有用的WORD VBA代码1、删除空格'* +++++++++++++++++++++++++++++++++++++++'功能简介:删除空格''* ----------------------------------------Sub 删除空格()Dim FindChar As String, Fcount As Integer, RepChar As StringOn Error Resume NextApplication.ScreenUpdating = False '关闭屏幕更新FindChar = " "RepChar = ""With ActiveDocument.Content.Find '此处针对全文档Do While .Execute(findtext:=FindChar) = True '如果发现Fcount = Fcount + 1 '计数器LoopIf MsgBox("文档中共发现了" & Fcount & "个" & FindChar & vbCrLf _& ",按Yes键将进行下一步的替换工作,按No取消", vbYesNo + vbInformation) = vbYes Then.Execute findtext:=FindChar, Wrap:=wdFindContinue, replacewith:=RepChar, Replace:=wdReplaceAllEnd IfEnd WithApplication.ScreenUpdating = True'恢复屏幕更新End Sub2、段首空格删除第一种'* +++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''*-----------------------------------------Sub 删除段首空格1()Selection.WholeStory 'CTR+ASelection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'CTR+ESelection.ParagraphFormat.Reset 'CTR+QEnd Sub第二种'* +++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''* ----------------------------------------Sub 删除段首空格2()Dim i As Paragraph, n As LongApplication.ScreenUpdating = False '关闭屏幕刷新For Each i In ActiveDocument.Paragraphs '在活动文档的段落集合中循环For n = 1 To i.Range.Characters.CountIf i.Range Like " *" _Or i.Range Like " *" Theni.Range.Characters(1).DeleteElse: Exit ForEnd IfNext nNextApplication.ScreenUpdating = True '恢复屏幕刷新 End Sub第三种'* +++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''* ----------------------------------------Sub 删除段首空格3()Dim i As Paragraph, n As LongApplication.ScreenUpdating = False '关闭屏幕刷新For Each i In ActiveDocument.Paragraphs '在活动文档的段落集合中循环For n = 1 To i.Range.Characters.CountIf i.Range.Characters(1).Text = " " _Or i.Range.Characters(1).Text = " " Theni.Range.Characters(1).DeleteElse: Exit ForEnd IfNext nNextApplication.ScreenUpdating = True '恢复屏幕刷新End Sub3、删除空白段落'功能简介:可以对指定长度的段落进行删除,当LEN=1时'可对空白段落进行删除。
vb操作word大全
1、对其WORD内容设置字体样式,以及在WORD中插入表格,以及表格单元格融合与填充.Option ExplicitPrivate Sub Command1_Click()Dim filename As StringCD.ShowSavefilename = CD.filenameOutWord filenameMsgBox "OK"End SubPrivate Function OutWord(ByVal filePath As String) As BooleanDim newDoc As Word.DocumentSet newDoc = New Word.DocumentWith newDoc.Paragraphs(.Paragraphs.Count) = "宋体".Paragraphs(.Paragraphs.Count).Range.Font.Size = 10.5.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphRight.Content.InsertAfter "編号:" & vbCrLf.Paragraphs(.Paragraphs.Count) = "宋体".Paragraphs(.Paragraphs.Count).Range.Font.Size = 26.Paragraphs(.Paragraphs.Count).Range.Font.Bold = True.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphCenter.Content.InsertAfter vbCrLf & "XXXXXXXXX報告" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf.Paragraphs(.Paragraphs.Count) = "宋体".Paragraphs(.Paragraphs.Count).Range.Font.Size = 15.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft.Content.InsertAfter "项目名称:" & vbCrLf.Content.InsertAfter "应急类型:" & vbCrLf.Content.InsertAfter "预警状态:正常/警界/危机" & vbCrLf.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphCenter.Tables.Add Range:=.Range(Start:=.Range.End - 1, End:=.Range.End), NumRows:=1, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixedWith .Tables(1)If .Style <> "表(格子)" Then.Style = "表(格子)"End If.ApplyStyleHeadingRows = True.ApplyStyleLastRow = True.ApplyStyleFirstColumn = True.ApplyStyleLastColumn = True.Columns.Width = 50.Rows.Height = 20End With.Paragraphs(.Paragraphs.Count) = "宋体".Paragraphs(.Paragraphs.Count).Range.Font.Size = 15.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft.Content.InsertAfter "委托人:" & vbCrLf.Content.InsertAfter "预警机构:" & vbCrLf.Content.InsertAfter "报告负责人:" & vbCrLf.Content.InsertAfter "时间:" & vbCrLf.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft.Tables.Add Range:=.Range(Start:=.Range.End - 1, End:=.Range.End), NumRows:=8, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixedWith .Tables(2)If .Style <> "表(格子)" Then.Style = "表(格子)"End If.ApplyStyleHeadingRows = True.ApplyStyleLastRow = True.ApplyStyleFirstColumn = True.ApplyStyleLastColumn = True.Cell(2, 1).Range.Text = "项目名称".Range.Cells(3).Row.Cells.Merge.Range.Cells(3).Range.Font.Size = 15.Range.Cells(3).Range.Text = "信息来源/文献检索范围:" & vbCrLf & vbCrLf & vbCrLf.Range.Cells(4).Row.Cells.Merge.Range.Cells(4).Range.Text = "情况描述/检索结果:" & vbCrLf & vbCrLf & vbCrLf .Range.Cells(5).Row.Cells.Merge.Range.Cells(5).Range.Text = "影响分析:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf .Range.Cells(6).Row.Cells.Merge.Range.Cells(6).Range.Text = "建议:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf.Range.Cells(7).Row.Cells.Merge.Range.Cells(7).Range.Text = "专家组成员:" & vbCrLf & vbCrLf & vbCrLf &vbCrLf & vbCrLf & vbCrLf.Range.Cells(8).Row.Cells.Merge.Range.Cells(8).Range.Text = "附件目录:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf.Range.Cells(9).Row.Cells.Merge.Range.Cells(9).Range.Text = "报告负责人:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & " 年月日"End WithEnd WithnewDoc.SaveAs filePathnewDoc.CloseEnd Function2、VB程序操作word表格(文字、图片)很多人都知道,用vb操作excel的表格非常简单,但是偏偏项目中碰到了VB操作word表格的部分,google、baidu搜爆了,都没有找到我需要的东西。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
这里给大家提供一些比较常用的WORD VBA代码,可以提高大家的办公效率,如果不知道怎么使用这些代码,请自行上网查询WORD如何运行VBA。
1、删除空行
Sub 删除空行()
Dim I As Paragraph, n As Integer
= False
For Each I In
If Len(Trim) = 1 Then
n = n + 1
End If
Next
MsgBox "共删除空白段落" & n & "个"
= True
End Sub
2、奇偶页打印
Sub 奇偶页打印()
Dim x, j, i As Integer
On Error Resume Next
x = ExecuteExcel4Macro("(50)")
For i = 1 To Int(x / 2) + 1
From:=2 * i - 1, To:=2 * i - 1
Next i
If x = 1 Then
MsgBox "无偶数页"
Else
MsgBox "请将打印出的纸张反向装入纸槽中", vbOKOnly, "打印另一面"
For j = 1 To Int(x / 2) + 1
From:=2 * j, To:=2 * j
Next j
End If
End Sub
3、中英文标点互换
Sub 中英文标点互换()
Dim ChineseInterpunction() As Variant, EnglishInterpunction() As Variant
Dim myArray1() As Variant, myArray2() As Variant, strFind As String, strRep As String Dim msgResult As VbMsgBoxResult, N As Byte
'定义一个中文标点的数组对象
ChineseInterpunction = Array("、","。
", ",", ";", ":", "", "!", "……", "—", "~", "(", ")", "《", "》")
'定义一个英文标点的数组对象
EnglishInterpunction = Array(",",".",",",";", ":","", "!", "…", "-", "~", "(",
")", "<", ">")
'注意这里的英文,转换为了中文、,如果希望将,转换为中文,请自行修改!
'提示用户交互的MSGBOX对话框
msgResult = MsgBox("您想中英标点互换吗按Y将中文标点转为英文标点,按N将英文标点转为中文标点!", vbYesNoCancel)
Select Case msgResult
Case vbCancel
Exit Sub '如果用户选择了取消按钮,则退出程序运行
Case vbYes '如果用户选择了YES,则将中文标点转换为英文标点
myArray1 = ChineseInterpunction
myArray2 = EnglishInterpunction
strFind = "“(*)”"
strRep = """\1"""
Case vbNo '如果用户选择了NO,则将英文标点转换为中文标点
myArray1 = EnglishInterpunction
myArray2 = ChineseInterpunction
strFind = """(*)"""
strRep = "“\1”"
End Select
= False '关闭屏幕更新
For N = 0 To UBound(ChineseInterpunction) '从数组的下标到上标间作一个循环
With
.ClearFormatting '不限定查找格式
.MatchWildcards = False '不使用通配符
'查找相应的英文标点,替换为对应的中文标点
.Execute findtext:=myArray1(N), replacewith:=myArray2(N), Replace:=wdReplaceAll End With
Next
With
.ClearFormatting '不限定查找格式
.MatchWildcards = True '使用通配符
.Execute findtext:=strFind, replacewith:=strRep, Replace:=wdReplaceAll
End With
= True '恢复屏幕更新
End Sub
4、任意页插入页码
Sub任意页插入页码()
Dim p As Integer
On Error Resume Next
p = InputBox("请输入起始编排页码的页次")
With Selection
.GoTo What:=wdGoToPage, Count:=p
.InsertBreak Type:=wdSectionBreakContinuous
.Sections(1).Footers(1).LinkToPrevious = False
With .Sections(1).Footers(1).PageNumbers
.RestartNumberingAtSection = True
.StartingNumber = 1
.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
End With
End With
End Sub
5、实现图形的精确旋转
Sub 图形旋转()
Dim blnIsInlineShape As Boolean
If = wdSelectionInlineShape Then
blnIsInlineShape = True
(1).ConvertToShape
End If
Dim intTurn As Integer
intTurn = InputBox("请输入图形要旋转的角度值" & vbCrLf & "正数表示顺时针,负数表示逆时针。
", "图形旋转", 30)
intTurn
End Sub
注释:上述代码中,首先是将嵌入式的图形转换为可以自由浮动的图形。
返回Wo rd 窗口之后,选中文档中需要旋转的某幅图形,按下Alt+F8组合键,选中列表框中的“图形旋转”宏,单击“运行”按钮弹出一个对话框,默认的旋转角度是30°,例如设置为“33”,很快就可以完成旋转操作。