高达seed人物关系:word 宏的使用

Word宏处理常用代码

vb环境中输入以下代码：

·················································

1.调整图片大小

·················································

Sub setpicsize() '设置图片大小
Dim n '图片个数
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
ActiveDocument.InlineShapes(n).Height = 400 '设置图片高度为 400px
ActiveDocument.InlineShapes(n).Width = 300 '设置图片宽度 300px
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
ActiveDocument.Shapes(n).Height = 400 '设置图片高度为 400px
ActiveDocument.Shapes(n).Width = 300 '设置图片宽度 300px
Next n
End Sub

·················································

2.转字体

·················································

Sub 批量设置小5号字体() '此代码为指定文件夹中所有选取的WORD文件的进行格式设置
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
' On Error Resume Next '忽略错误
'定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Title = "请选择要处理的文档（可多选）"
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
Application.ScreenUpdating = False
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set Doc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
With Doc

With .Content
With .Font
' .NameFarEast = "宋体" '中文字体，已禁用
' .NameAscii = "Times New Roman" '英文字体，已禁用
.Size = 9
End With
End With
.Close True
End With
Next
Application.ScreenUpdating = True
End If
End With
MsgBox "批量设置完毕!", vbInformation
End Sub

·················································

3.转文件格式

·················································

Sub Macro1()
'
' Macro1 Macro
' 宏在 01-10-31 由 WDX 录制
'
Dim name As String '文件名
name = "01"
ChangeFileOpenDirectory "E:\VB_SOUCE\lib\"

For i = 1 To 2124 '文件数2124
Documents.Open filename:=name & ".txt", ConfirmConversions:=False, ReadOnly:= _
False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
"", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto
ActiveDocument.SaveAs filename:=name & ".txt", FileFormat:= _
wdFormatTextLineBreaks, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
ActiveWindow.Close

name = name + 1
If name < 10 Then name = "0" & name
Next i
End Sub

使用Word的宏删除多余回车及空格行

如果拷贝下来的文字里有连续的多行空行，或者在有些空行里还有数量不等的空格字符，不妨让Word的宏来一显身手。
　　创建一个宏，取名为DBL。代码及注释如下：
　　Sub DBL()
　　i = 1
　　Do
　　'从当前文档的顶端开始逐一选择文档的每一段文字
　　ActiveDocument.Paragraphs(i).Range.Select
　　If Trim(Selection.Text) = Chr(13) Then
　　'如果选择的段落里只有回车符和空格则删除此段
　　Selection.Delete
　　Else
　　'如果选择的段落非空，就将选择的指针移向下一段
　　Selection.MoveDown
　　i = i + 1
　　End If
　　Loop Until i = ActiveDocument.Paragraphs(i).Count
　　End Sub
　　写好了宏程序之后，可以把刚才建好的宏拖拽到快捷工具栏上，做好以后，如果需要从网页上拷贝文字到Word上编辑时，只要单击一次这个宏按钮，即可瞬间删除整篇文档里的空行了。

附后：

1. '/*******************************************************************/
2. '/作者: darkread     mail:darkread@gmail.com                           /
3. '/小组: CD Team                                                       /
4. '/功能:清除当前文档中所有多余的回车                                   /
5. '/过程:word,检索每一段，如果在清除了空格（含全角）后只剩一个回车，那 /
6. '/么删除该段                                                         /
7. '/权利:在使用或者发布时请保留该注释，谢谢                             /
8. '/*******************************************************************/
9. Sub ClearEnter()
10. Const SPACECHR = " "
11. Const SPACEWCHR = "　"
12. Dim rg As Range
13. Set rg = ActiveDocument.Range
14. Dim i As Integer
15. Dim sTxt As String
16. i = 1
17. While (i <= rg.Paragraphs.Count)
18.      sTxt = rg.Paragraphs(i).Range.Text
19.      sTxt = Replace(sTxt, SPACECHR, "")
20.      sTxt = Replace(sTxt, SPACEWCHR, "")
21.     If Len(sTxt) <= 2 Then
22.          rg.Paragraphs(i).Range.Delete
23.         If i >= rg.Paragraphs.Count Then
24.             GoTo ENDWHILE
25.         End If
26.     Else
27.          i = i + 1
28.     End If
29. Wend
30. ENDWHILE:
31. End Sub