批量复制指定格式的内容

ww0000 · 发表于 2015-5-19 17:24

批量复制指定格式的内容.rar (12.85 KB, 下载次数: 44)

ww0000 · 发表于 2015-5-21 17:12

各位老师看了如何??

kqbt · 发表于 2015-5-22 12:27

可在2003版本下试试如下代码（未经优化）：

Sub PickRedRange()
Dim sPat As String, sStr As String
Dim nNum As Long, wDoc As Document, wRng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> -1 Then Exit Sub
sPat = .SelectedItems(1) & ""
End With
sStr = ""
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = sPat
.FileType = msoFileTypeWordDocuments
For nNum = 1 To .Execute
sStr = sStr & Mid(.FoundFiles(nNum), Len(sPat) + 1, Len(.FoundFiles(nNum)) - Len(sPat) - 4) & vbCrLf
Set wDoc = Documents.Open(.FoundFiles(nNum), Visible = False)
Set wRng = wDoc.Range
With wRng.Find
.ClearFormatting
.Font.Color = wdColorRed
Do While .Execute
sStr = sStr & wRng & vbCrLf
Loop
End With
wDoc.Close False
Next
End With
Application.ScreenUpdating = True
ActiveDocument.Range.InsertAfter vbCrLf & sStr
End Sub

复制代码

注：类似问题论坛中应该有现成案例可参考的，可通过搜索查找出来。

413191246se · 发表于 2015-5-22 19:37

版主代码编得真好！我水平太低实在看不懂！——但运行出错，请版主重审（打开源文件夹后，确定，并不能打开任何文件；还有，visible后面应该加冒号吧。）——另外，楼主会不会用VBA宏代码？应该说一下。

413191246se · 发表于 2015-5-22 19:39

另外，我再问一下版主：是否有一个小程序，能自动把VBA宏代码放到VBE环境中，让不懂得用VBA宏代码的朋友，只须点击此小程序，就可以自动运行某个宏？

kqbt · 发表于 2015-5-22 20:49

再次在2003版本下运行未发现错误啊。413191246se 是否是在2007或更高版本测试的？
谢谢指正 visible:=false 错误！当时写得有点仓促未仔细检查。
“小程序”的想法很好！如果能实现将会非常人性化！目前我似乎没有见过，应该有高手能解决的。不知道VBS能否实现？而且宏安全性可能还是一道屏障。

ww0000 · 发表于 2015-5-22 22:31

kqbt 发表于 2015-5-22 12:27
可在2003版本下试试如下代码（未经优化）：
注：类似问题论坛中应该有现成案例可参考的，可通过搜索查找出 ...

我在XP运行成功，谢谢

ww0000 · 发表于 2015-5-23 14:28

kqbt 发表于 2015-5-22 12:27
可在2003版本下试试如下代码（未经优化）：
注：类似问题论坛中应该有现成案例可参考的，可通过搜索查找出 ...

老大：要是能带格式复制过来就更好了！如何改？

kqbt · 发表于 2015-5-25 08:38

ww0000 发表于 2015-5-23 14:28
老大：要是能带格式复制过来就更好了！如何改？

若要保留格式，可通过宏完成 Ctrl+C → Ctrl + V 的过程，不过效率将会受到影响。

loquat · 发表于 2015-5-25 12:50

kqbt 发表于 2015-5-22 20:49
再次在2003版本下运行未发现错误啊。413191246se 是否是在2007或更高版本测试的？
谢谢指正 visible:=fals ...

使用vbs可以跳过安全性。

		自动登录	找回密码
密码			免费注册

[求助] 批量复制指定格式的内容

评分