一些Word文档处理中常用的VBA代码

Sub delBlankLine() 
'删除只有一个回车的行 
i = 1 
paNo = ActiveDocument.Paragraphs.Count 
While i <= paNo 
 chNo = ActiveDocument.Paragraphs(i).Range.Characters.Count 
 If chNo = 1 Then 
  ActiveDocument.Paragraphs(i).Range.Delete 
  paNo = paNo - 1 
 Else 
  i = i + 1 
 End If 
Wend 
End Sub 

Sub OpenDoc() 
' 
'打开一个文件，给出提示，然后退出 
' 
 Documents.Open FileName:="f:\CommandCm.java", ConfirmConversions:=False, ReadOnly:=True 
 MsgBox "opened!" 
 ActiveDocument.Close 
End Sub 

Sub debugDemo() 


' 用 Debug.Print调试VBA代码 


 ' 输出结果在“立即窗口”中呈现，用Visual Basic编辑器【视图->立即窗口】调出 


' 下面演示了输出当前文档的第一段文本 
 Dim TestString As String 
 TestString = ActiveDocument.Paragraphs(1).Range.Text 
 Debug.Print TestString 
End Sub


Sub DeleteLine() 
' 
' 删除特定的行 
' 宏在 2006-11-19 由 李超 录制 
' 
paraNo = ActiveDocument.Paragraphs.Count 
For i = 1 To paraNo 
 chNo = ActiveDocument.Paragraphs(i).Range.Characters.Count 
 If chNo = 25 Then 
  If ActiveDocument.Paragraphs(i).Range.Characters(12) = " " Then 
   ActiveDocument.Paragraphs(i).Range.Text = "*********" + Chr(13) 
  End If 
 Else 
  wordNo = ActiveDocument.Paragraphs(i).Range.Words.Count 
  If wordNo > 1 Then 
   ActiveDocument.Paragraphs(i).Range.Words(wordNo - 1).Text = ActiveDocument.Paragraphs(i).Range.Words(wordNo - 1).Text + " " 
  End If 
 End If 
Next 
End Sub 

Sub delNumber() 
'删除文本中的数字 
paraNo = ActiveDocument.Paragraphs.Count 
For i = 1 To paraNo 
 chNo = ActiveDocument.Paragraphs(i).Range.Characters.Count 
 For j = 1 To chNo 
  isNo = AscW(ActiveDocument.Paragraphs(i).Range.Characters(j)) 
  If isNo > 47 And isNo < 58 Then 
   ActiveDocument.Paragraphs(i).Range.Characters(j) = " " 
  End If 
 Next 
Next 
End Sub 

Sub 上标() 
' 
' 上标 Macro 
' 宏在 2006-12-9 由 李超 录制 
' 
 With Selection.Font 
  .NameFarEast = "宋体" 
  .NameAscii = "Times New Roman" 
  .NameOther = "Times New Roman" 
  .Name = "Times New Roman" 
  .Size = 12 
  .Bold = False 
  .Italic = False 
  .Underline = wdUnderlineNone 
  .UnderlineColor = wdColorAutomatic 
  .StrikeThrough = False 
  .DoubleStrikeThrough = False 
  .Outline = False 
  .Emboss = False 
  .Shadow = False 
  .Hidden = False 
  .SmallCaps = False 
  .AllCaps = False 
  .Color = wdColorAutomatic 
  .Engrave = False 
  .Superscript = True 
  .Subscript = False 
  .Spacing = 0 
  .Scaling = 100 
  .Position = 0 
  .Kerning = 1 
  .Animation = wdAnimationNone 
  .DisableCharacterSpaceGrid = False 
  .EmphasisMark = wdEmphasisMarkNone 
 End With 
End Sub

Sub ModifyPicSize() 
' 
' ModifyPicSize Macro 
' 宏在 2006-12-17 由 李超 录制 
' 
 Selection.InlineShapes(1).Fill.Visible = msoFalse 
 Selection.InlineShapes(1).Fill.Solid 
 Selection.InlineShapes(1).Fill.Transparency = 0# 
 Selection.InlineShapes(1).Line.Weight = 0.75 
 Selection.InlineShapes(1).Line.Transparency = 0# 
 Selection.InlineShapes(1).Line.Visible = msoFalse 
 Selection.InlineShapes(1).LockAspectRatio = msoTrue 
 Selection.InlineShapes(1).Height = 361.15 
 Selection.InlineShapes(1).Width = 278.95 
 Selection.InlineShapes(1).PictureFormat.Brightness = 0.5 
 Selection.InlineShapes(1).PictureFormat.Contrast = 0.5 
 Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic 
 Selection.InlineShapes(1).PictureFormat.CropLeft = 0# 
 Selection.InlineShapes(1).PictureFormat.CropRight = 0# 
 Selection.InlineShapes(1).PictureFormat.CropTop = 0# 
 Selection.InlineShapes(1).PictureFormat.CropBottom = 0# 
End Sub