Word ، Excel دىكى مەزمۇننى توپ ئالماشتۇرۇش كودى

Intil · ۋاقتى: 2011-2-18 01:31:59

بۇ كودلار لازىم بولىدۇ:

\'更改Excel文件内容
Private Sub Command2_Click()
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
FileCopy "D:\demo\1.xls", "D:\demo\2.xls" \'将文件名 1 改为 2
Kill "D:\demo\1.xls"
Set xlBook = xlApp.Workbooks.Open("D:\demo\2.xls")
Set xlSheet = xlBook.ActiveSheet
xlSheet.Cells.Replace "1", "2"
xlBook.Save
xlBook.Close
xlApp.Quit
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

بۇ كودنى توردىن تاپتىم، 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
'----------------------

مەزمۇننى كۆچۈرۈۋېلىش

ھېسابات		ساقلاش	پارول قايتۇرىۋېلىش
پارول			تىزىملىتىش

مىكروبلوگ[ يېڭى | 24 سائەت | 7 كۈن | 30 كۈن ]

[بىلىم] Word ، Excel دىكى مەزمۇننى توپ ئالماشتۇرۇش كودى