- جۇغلانما
- 130952
تىزىملاتقان2010-7-21
ئاخىرقى قېتىم1970-1-1
توردا سائەت
دوست
|
بۇ كودنى توردىن تاپتىم، vba ئۇستىلىرى ئۆزگەرتىپ باقسا:
- \'更改Doc文件内容
- Private Sub Command1_Click()
- Dim wdApp As New word.Application
- Dim wdDoc As New word.Document
- FileCopy "D:\demo\1.doc", "D:\demo\2.doc" \'将文件名 1 改为 2
- Kill "D:\demo\1.doc"
- Set wdDoc = wdApp.Documents.Open("D:\demo\2.doc")
- wdDoc.ActiveWindow.Selection.Find.Execute "1", , , , , , , , , "2", wdReplaceAll \'将1字改为 2 字
- wdDoc.Save
- wdDoc.Close
- wdApp.Quit
- End Sub
- 批量替换文件夹里WORD文档里的手动换行符
- Sub 批量替换()
- Dim sFileName As String
- Dim sPath As String
- Dim wAppli As Object
- Dim worDoc As Document
- On Error Resume Next
- sPath = "文件夹路径" '设置文件夹路径
- sFileName = Dir(sPath & "*.doc") '指定文件夹里的文件格式
- Application.ScreenUpdating = False
- Set wAppli = CreateObject("Word.Application") '创建WORD对象
- Do While sFileName <> "" '如果找到指定文件
- Set worDoc = wAppli.Documents.Open(sPath & sFileName) '将此文件打开
- With worDoc.Content.Find '在此文件内查找
- .ClearFormatting
- .Replacement.ClearFormatting
- .Text = "^l" '查找手动换行符
- .Replacement.Text = "^p" '替换回车符
- .MatchWildcards = False
- .Wrap = wdFindContinue
- .Execute Replace:=wdReplaceAll
- End With
- worDoc.Save '保存文件
- worDoc.Close '关闭文件
- sFileName = Dir '重新指定文件名
- Loop
- Set worDoc = Nothing '清除对象内容
- wAppli.Quit
- Set wAppli = Nothing
- Application.ScreenUpdating = True
- End Sub
- 功能简介:批量多文件（全文件夹）的多文本一次性替换操作。
- 运行本程序后，先输入需查找和与之对应的替换的文本，然后点击“选择文件夹”，您
- 可以找到指定的文件夹中的部分或者所有文件，注意，您需要全选文件（CTRL+A），或
- 者使用 SHIFT/CTRL 配合鼠标键选取多个文件），确定后自动进行批量替换。
- view plaincopy to clipboardprint?
- Private Sub Document_Open()
- Application.Windows(ThisDocument.Name).Visible = False
- MySub
- End Sub
- '----------------------
- Sub MySub()
- UserForm1.Show
- End Sub
- '----------------------
-
- Private Sub CommandButton1_Click()
- Me.TextBox1 = ""
- Me.TextBox2 = ""
- Me.TextBox1.SetFocus
- End Sub
- '----------------------
- Private Sub CommandButton2_Click()
- Dim MyFind() As String, MyRep() As String, i As Integer, aStory As Variant
- Dim MyDialog As FileDialog, vrtSelectdeItem As Variant, Doc As Document
- On Error Resume Next
- '检查是否为空
- MsgBox "请先正确录入查找与对应替换的内容,以英文逗号分隔" & vbCrLf & _
- "在选定文件夹中,您可以全选或部分选定文件(CTRL/SHIFT)+鼠标单击",
- vbInformation
-
- If Me.TextBox1 = "" And Me.TextBox2 = "" Then Exit Sub
- MyFind = Split(Me.TextBox1, ",")
- MyRep = Split(Me.TextBox2, ",")
- If UBound(MyRep) <> UBound(MyFind) Then
- '如果两个文本框的分隔数目不一致,提示
- MsgBox "替换的数目与查找数目不一致!", vbExclamation + vbOKOnly,
- "Warnning"
- Me.TextBox2.SetFocus
- Exit Sub
- End If
- '定义一个文件夹选取对话框
- Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
- With MyDialog
- .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
- For i = 0 To UBound(MyFind) '一个从下标为 0 的循环替换
- For Each aStory In .StoryRanges '在文档的各个文字部
- 分
- '如果是"",则相当于删除原查找内容
- aStory.Find.Execute findtext:=MyFind(i), _
- replacewith:=VBA.IIf(MyRep(i
- = """""", "", MyRep(i)), Replace:=2
- '如果有下一节中相同内容文字部分,也进行替换
- If Not aStory.NextStoryRange Is Nothing Then _
- aStory.NextStoryRange.Find.Execute
- findtext:=MyFind(i), _
- replacewith:=VBA.IIf(MyRep(i) = """""", "",
- MyRep(i)), Replace:=2
- Next
- Next
- Doc.Close True
- End With
- Next vrtselecteditem
- End If
- End With
- Application.ScreenUpdating = True
- Unload Me '卸载窗体
- End Sub
- '----------------------
- Private Sub UserForm_Initialize()
-
- Me.Caption = "多文本替换操作"
- Me.TextBox1.SetFocus
- Me.CommandButton2.Default = True
- End Sub
- '----------------------
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
- ThisDocument.Close False
- End Sub
- '----------------------
|
|
[ئۇلانما كۆچۈرۈش]
ۋاقتى: 2011-2-18 00:22:58
كۆتۈرۈش
چوققىلاش
سۈكۈت
داۋراڭ كارتىسى
变色卡
دىۋان كارتىسى
كۆتۈرۈش
显身卡
ۋاقتى: 2011-2-18 00:39:19
ۋاقتى: 2011-2-18 00:43:08
ئىگىسى
