怎样让多个文件同时执行相同的操作

zifengg

　　抱歉，上次的帖子发文不清淅。其实我的意思是这样，每天从邮箱取得的邮件保存到桌面上，都需要打开，并且执行同样的操作。我想能不能采用宏的方式将它们一次性地用Word打开，并且一个个地执行相同的操作。 　　工作如下： epjEdDD1.rar (99.14 KB, 下载次数: 18)

2005-12-26 14:31 上传

点击文件名下载附件
怎样让多个文件同时执行相同的操作

　　对于单的个文件，我自己录制了一个宏，并且做了一点简单的修改与调整。 Sub Macro4() Dim myname Dim atable As Table myname = Mid(ActiveDocument.Name, 1, 4) Select Case myname Case "银河财经" myname = "cjnc" Case "银河资本" myname = "zbnc" Case "银河高端" myname = "gdnc" Case "公司研究" myname = "gsyjsl20" End Select Selection.WholeStory Selection.Cut ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _ 1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed With Selection.Tables(1) If .Style <> "网格型" Then .Style = "网格型" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = True .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = True End With Selection.PasteAndFormat (wdPasteDefault) Application.ScreenUpdating = False Debug.Print Timer For Each atable In ActiveDocument.Tables atable.Rows.Alignment = wdAlignRowCenter Next Application.ScreenUpdating = True ActiveDocument.SaveAs FileName:="C:\Documents and Settings\whcj\桌面\当日工作\" & myname & Format(VBA.Date, "yymmdd") & ".htm", FileFormat:= _ wdFormatHTML ActiveWindow.View.Type = wdWebView ActiveWindow.ActivePane.VerticalPercentScrolled = 0 Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=547.55, RulerStyle:= _ wdAdjustNone ActiveDocument.Save End Sub 　　现在我想问的是怎么将这个代码继续优化一下，能不能让这四个文件一次性的执行完全呢？ 　　由于水平有限，代码中红色的部分是我搞不清楚作用的地方，请大家教我一下。谢谢！

konggs

这个贴子有对文件夹操作的一般方法：（注是参考老大的程序的）

http://club.excelhome.net/viewthread.php?tid=139923&replyID=&skin=0

没看你的附件。

这个好像能略去吧

If .Style "网格型" Then
.Style = "网格型"
End If

守柔

更简单一些的：

请将以下代码复制于NORMAL.DOT的THISDOCUMENT模块下,这是利用模板的打开事件进行自动操作的一个宏,你可以直接选定你想要打开的文件右击打开也可以,在WORD中,使用文件打开也可以,你可以同时选定多个文件.

至于楼主的红色代码部分,这是录制宏时所得,你使用的是自动套用表格格式,由于本过程中只有一个单元格的表格,这些代码没有意义,但网格型是规范其边框线的,可以使用.
Private Sub Document_Open()
Dim myName As String, atable As Table
Application.ScreenUpdating = False
With ActiveDocument
myName = Mid(.Name, 1, 4)
Select Case myName
Case "银河财经"
myName = "cjnc"
Case "银河资本"
myName = "zbnc"
Case "银河高端"
myName = "gdnc"
Case "公司研究"
myName = "gsyjsl20"
End Select
.Content.Cut
.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With .Tables(1)
If Not .Style = "网格型" Then .Style = "网格型"
.Cell(1, 1).Range.Paste
End With
For Each atable In .Tables
atable.Rows.Alignment = wdAlignRowCenter
Next
.Tables(1).Columns(1).SetWidth ColumnWidth:=547.55, RulerStyle:=wdAdjustNone
.SaveAs FileName:="C:\Documents and Settings\whcj\桌面\当日工作\" & myName & Format(VBA.Date, "yymmdd") & ".htm", FileFormat:= wdFormatHTML
End With
Application.ScreenUpdating = True
End Sub

zifengg

　不好意思，我找不到守柔说的那个NORMAL.DOT的THISDOCUMENT模块的位置。能说一下吗？

　　另有两个小问题也需要帮忙解决一下：

　　１、怎样自动判断文件中是否包含有图片，如果有，则将图片全部删除。

　　２、我想将文件的标题更改为我想要的文件标题（注：此文件标题不是文件名，而是文件作为HTML页时显示的文件标题，应该是网页的TITLE部分。），但是在录制的过程中都没有这部分的内容，我该如何做呢？

　　我是刚开始使用WORD录制与编辑宏，很多地方不知道，请大家多多帮助。

[此贴子已经被作者于2005-12-27 10:00:05编辑过]

守柔

先解决第一个问题，请认真阅读一遍以下链接，我相信，你会收益很多。

http://club.excelhome.net/viewthread.php?tid=110721

zifengg

　是的，现在可以做到了。但是这样操作后，每一个被word打开的文档无论需不需要都会执行这样的操作。

　　能不能有选择地执行呢，或者是指定文件执行此操作？

　　我想可以加一个判断，判断该文件是否是这四个文件，如果是，刚执行程序；如果不是，则不执行该程序。

　　但是我不知道在VBA中这样的语句怎么写，请告知。

守柔

case else

exit sub

zifengg

　　完成了，我是将简单的问题想繁杂了。

　　那么另两个问题怎么解决呢？

　

　１、怎样自动判断文件中是否包含有图片，如果有，则将图片全部删除。

　　２、我想将文件的标题更改为我想要的文件标题（注：此文件标题不是文件名，而是文件作为HTML页时显示的文件标题，应该是网页的TITLE部分。），但是在录制的过程中都没有这部分的内容，我该如何做呢？

[此贴子已经被作者于2005-12-29 10:48:37编辑过]

守柔

Option Explicit

Private Sub Document_Open()
Dim myName As String, atable As Table
Dim aShape As Shape, aLineshape As InlineShape
Application.ScreenUpdating = False
With ActiveDocument
myName = Mid(.Name, 1, 4)
Select Case myName
Case "银河财经"
myName = "cjnc"
Case "银河资本"
myName = "zbnc"
Case "银河高端"
myName = "gdnc"
Case "公司研究"
myName = "gsyjsl20"
Case Else
Exit Sub
End Select
.Content.Cut
.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With .Tables(1)
If Not .Style = "网格型" Then .Style = "网格型"
.Cell(1, 1).Range.Paste
End With
For Each atable In .Tables
atable.Rows.Alignment = wdAlignRowCenter
Next
'删除图形对象
For Each aShape In .Shapes
aShape.Delete
Next
'删除嵌入式图形对象(视情况是否需要)
For Each aLineshape In .InlineShapes
aLineshape.Delete
Next
.Tables(1).Columns(1).SetWidth ColumnWidth:=547.55, RulerStyle:=wdAdjustNone
.BuiltInDocumentProperties(wdPropertyTitle) = "MyTitle" 'WEB标题
.SaveAs FileName:="C:\Documents and Settings\whcj\桌面\当日工作\" & myName & Format(VBA.Date, "yymmdd") & ".htm", FileFormat:=wdFormatHTML
End With
Application.ScreenUpdating = True
End Sub

zifengg

　　谢谢守柔的代码，元旦上班后试验。