负面情绪奶豆
Word VBA教程：Delete方法
VBA教程 - Word VBA参考教程 - Delete方法Word VBA教程：Delete方法应用于 Cell 和 Cells对象的 Delete方法。
删除一个或多个表格单元格并可选择控制如何移动剩余的单元格。
expression.Delete(ShiftCells)expression 必需。
该表达式返回以上一个对象。
ShiftCells Variant 类型，可选。
剩余单元格移动的方向。
可以是任意WdDeleteCells 常量。
如果忽略，最后删除的单元格的右侧单元格向左移动。
应用于 Range 和 Selection对象的 Delete方法。
删除指定数目的字符或单词。
此方法返回一个 Long 值，该数值表明删除项的数目。
如果删除失败，则返回的值为 0（零）。
expression.Delete(Unit, Count)expression 必需。
该表达式返回以上一个对象。
Unit Variant 类型，可选。
所需删除的折叠区域或选定内容的单位。
可以是下列 WdUnits 常量之一：wdCharacter（默认值）或 wdWord。
Count Variant 类型，可选。
所需删除的单元的数目。
若要删除某区域或选定内容之后的单元，请折叠该区域或选定内容并将此参数设置为正数；若要删除某区域或选定内容之前的单元，请折叠该区域或选定内容并将此参数设置为负数。
应用于 ShapeNodes对象的 Delete方法。
删除指定的对象。
expression.Delete(Index)expression 必需。
该表达式返回一个ShapeNodes对象。
Index Long 类型，必需。
要删除的图形节点的数目。
应用于“应用于”列表中所有其他对象的 Delete方法。
删除指定的对象。
expression.Deleteexpression 必需。
该表达式返回“应用于”列表中的一个对象。
http://www.33dir.com/z/2016/08/04/2957.html
VBA For Word关于替换的几个问题,高手请进
开启模糊查询即可，再判断一下查找的长度Sub 分章（）Set myrange = ActiveDocument.ContentFor n = 1 To 8myrange.Find.Execute findtext：=＂第*章＂， Forward:=True, MatchWildcards:=TrueIf myrange.End - myrange.Start < 20 Thenmyrange.Style = ActiveDocument.Styles（＂标题 2＂）End IfNextEnd Sub测试运行了下，效果有点不好，修改一下Sub 分章（）Set myrange = ActiveDocument.ContentFor n = 1 To 8myrange.Find.Execute findtext：=＂第*章＂， Forward:=True, MatchWildcards:=TrueIf myrange.End - myrange.Start < 20 Thenmyrange.Style = ActiveDocument.Styles（＂标题 2＂）Elsemyrange.Start = myrange.Start + 1End IfNextEnd Sub
用vba给word的 表格中的图片 加边框时 边框加到表格上
经测试编写VBA代码如下：Sub 嵌入式图片加边框（）Application.ScreenUpdating = FalseDim a As IntegerDim pic As InlineShapeDim aBorder As Bordera = ActiveDocument.InlineShapes.CountIf a = 0 ThenMsgBox （＂没有发现嵌入式图片＂）End IfFor Each pic In ActiveDocument.InlineShapespic.Borders.Enable = TrueWith picFor Each aBorder In pic.BordersWith aBorder.LineWidth = wdLineWidth025pt.Color = wdColorBlueEnd WithNext aBorder.ScaleHeight = 100.ScaleWidth = 100End WithNextApplication.ScreenUpdating = TrueEnd SubSub 取消边框（）Dim a As Integera = ActiveDocument.InlineShapes.CountIf a = 0 ThenMsgBox （＂没有发现嵌入式图片＂）End IfActiveDocument.InlineShapes(1).Borders.Enable = FalseEnd SubPrivate Sub CommandButton1_Click()嵌入式图片加边框End SubPrivate Sub CommandButton2_Click()取消边框End Sub效果如下：
怎么用excel vba操控word插入图片,求高手给一小段示例
如果想按照指定页数拆分，请使用下面的代码，其它步骤和原来那个方案相同。
Option ExplicitSub SplitEveryFivePagesAsDocuments()Dim oSrcDoc As Document, oNewDoc As DocumentDim strSrcName As String, strNewName As StringDim oRange As RangeDim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As IntegerDim fso As ObjectConst nSteps = 100 ' 修改这里控制每隔几页分割一次Set fso = CreateObject(＂Scripting.FileSystemObject＂)Set oSrcDoc = ActiveDocumentSet oRange = oSrcDoc.ContentnTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)oRange.Collapse wdCollapseStartoRange.SelectFor nIndex = 1 To nTotalPages Step nStepsSet oNewDoc = Documents.AddIf nIndex + nSteps >nTotalPages ThennBound = nTotalPagesElsenBound = nIndex + nSteps - 1End IfFor nSubIndex = nIndex To nBoundoSrcDoc.ActivateoSrcDoc.Bookmarks(＂\page＂).Range.CopyoSrcDoc.Windows(1).ActivateApplication.Browser.Target = wdBrowsePageApplication.Browser.NextoNewDoc.ActivateoNewDoc.Windows(1).Selection.PasteNext nSubIndexstrSrcName = oSrcDoc.FullNamestrNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _fso.GetBaseName(strSrcName) & ＂_＂ & (nIndex \ nSteps + 1) & ＂.＂ & fso.GetExtensionName(strSrcName))oNewDoc.SaveAs strNewNameoNewDoc.Close FalseNext nIndexSet oNewDoc = NothingSet oRange = NothingSet oSrcDoc = NothingSet fso = NothingMsgBox ＂结束！＂End Sub
如何用VBA取得Word文档中的标题前面的序号
Sub test() Dim myRange As Range Dim num as String, title as String 'Set ps = Selection.Bookmarks(＂\headinglevel＂).Range.Paragraphs Set ps = ActiveDocument.Bookmarks(＂\headinglevel＂).Range.Paragraphs For Each p In ps Set myRange = p.Range num = myRange.ListFormat.ListString title = myRange.Text MsgBox ＂编号：＂ & num & vbCrLf & ＂标题内容：＂ & title Next p 'Set myRange = Selection.Bookmarks(＂\headinglevel＂).Range.Paragraphs(1).Range 'MsgBox ＂编号：＂ & myRange.ListFormat.ListString & vbCrLf & ＂标题内容：＂ & myRange.Text End Sub 另外附上一段把标题（Heading）序号取出并附加在标题内容后面的代码：Sub ReplaceHeadingContent() Dim myRange As Word.Range Dim num As String, content As String '取得所有书签 Set ps = ActiveDocument.Bookmarks(＂\headinglevel＂).Range.Paragraphs '对书签中每一个段落进行处理 For Each p In ps Set myRange = p.Range With myRange '把Range结束范围往前移一个字符，目的是为了不包括换行符 .MoveEnd Unit:=wdWord, Count:=-1 '取出段落序号 num = Trim(.ListFormat.ListString) '取出Heading的内容 content = Trim(.Text) '如果段落序号不为空，则把段落序号取出附加的标题内容后面 If Trim(num) ＂＂ Then If num = ＂1.1.1.1.1.＂ Or num = ＂1.1.1.1.1＂ Then MsgBox ＂到目标点了。
＂ End If If Right(num, 1) = ＂.＂ Then num = Left(num, Len(num) - 1） '不需段落序号最后面的“.” .Text = content & ＂＂ End If 'MsgBox ＂编号：＂ & num & vbCrLf & ＂标题内容：＂ & content End With Next p End Sub
如何用VBA实现WORD批量替换？
操作步骤。
第一，首先将需要批量替换的多个Word文档放在同一文件夹下面。
第二，新建一空白Word文档，右击空白工具栏，单击“控件工具箱”，就可以看到屏幕上调出的控件工具箱。
第三，在控件工具箱上单击“命令按钮”，文档中就放置了一个按钮了。
第四，双击该按钮，进入VB代码编写模式，将以下代码复制进去。
Private Sub CommandButton1_Click()Application.ScreenUpdating = FalseDim myPas As String, myPath As String, i As Integer, myDoc As DocumentWith Application.FileDialog(msoFileDialogFolderPicker).Title = ＂选择目标文件夹＂If .Show = -1 ThenmyPath = .SelectedItems(1)ElseExit SubEnd IfEnd WithmyPas = InputBox（＂请输入打开密码：＂）With Application.FileSearch.LookIn = myPath.FileType = msoFileTypeWordDocumentsIf .Execute > 0 ThenFor i = 1 To .FoundFiles.CountSet myDoc = Documents.Open(FileName:=.FoundFiles(i), Passworddocument:=myPas)Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = ＂大家好＂.Replacement.Text = ＂你好＂.Forward = True.Wrap = wdFindAsk.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllmyDoc.SavemyDoc.CloseSet myDoc = NothingNextEnd IfEnd WithApplication.ScreenUpdating = TrueEnd Sub第五，保存上面代码，退出VB编辑模式，返回Word文档界面。
第六，单击选中该按钮，再单击控件工具箱的第一个按钮“退出设计模式”。
第七，进行测试：点击按钮，选择要放置多个WORD文档所在的文件夹，确定后即可完成！注意如果WORD文档没有加密的话，密码项就不填，直接确认。
就会发现该文件夹下面的所有WORD文档中“大家好”已被替换为“你好”了。
如何用VBA 向Word表格中插入值,又如何判断表格中的值是否为空
网上有现成的代码：========要判断 以上表格中如果有空时，则弹出对话框页面=========='当打开Word时弹出对话框 要用户输入内容 Private Sub Document_Open() Dim flag As Boolean flag = True With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Range For i = 2 To 9 Step 1 If Len(.Cells(i).Range.Text) = 2 Then flag = False End If Next If flag = False Then AddHeader.Show End If End With End Sub=====点确定后将页面对话框中的值 插入到word 的页眉表格中==== Private Sub CommandButton1_Click() With ActiveDocument.Sections(1)'Cell(4, 2).Range.InsertBefore (TextBox4.value) ' .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 2).Range.InsertAfter (＂aaa＂) .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 3).Range.Delete .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 3).Range.InsertAfter (TxtFileName.Value) .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 2).Range.Delete .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 2).Range.InsertAfter (TxtSecrecy.Value) .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 4).Range.Delete .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 4).Range.InsertAfter (TxtRev.Value) .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 6).Range.Delete .Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(2, 6).Range.InsertAfter (TxtID.Value) '页尾的做法' .Footers(wdHeaderFooterPrimary).Range.Text = ＂Copyright BYD Company Limited＂ End With AddHeader.Hide End Sub========提问 ================= 比如说sheet1 中A1:A10不为空，用代码判断不为空后，光标移向A11，并且A11=11,B11=22 再录入数据后光标又光标移向A12，并且A12=22,B12=23，依此类推========解决方法：=============================== Sub Text() If IsEmpty([A1]) Then [A1] = ＂你的数据＂ Else [A65536].End(xlUp).Offset(1, 0).Value = ＂你的数据＂ End If End Sub ========提问 ================= 判断word中表格是否为空========解决方法：==============================='a.Cells.Count=41,46,41+5*7 Dim list%'你的要求可能是这样 With ActiveDocument.Tables(1).Range For i = 41 To 41 + 5 * 7 Step 5 '测得第一项的后面对应的是第41个单元格，相差是5。
所以，step=5 list = list + 1 '利用list来得到是第几项没有加项 If Len(.Cells(i).Range.Text) = 2 Then '因为类回车加+竖线加在一起是2个长度。
所以。
。
这样判断 'n = .Cells(i - 4).Range.Text '取得单元格的内容+回车+竖线 'n = Mid(n, 1, Len(n) - 2） '去掉回车+竖线的，即我们所看到的内容 MsgBox ＂提示：没有给第＂ & list & ＂项打分！＂， vbOKOnly, ＂www.excelhome.net＂ .Cells(i).Range.Select '选中所在的单元格 Exit Sub End If Next End With
转载请注明出处51数据库 » vba for word教材
