以下是引用bth168在2005-8-10 13:50:41的发言：
对不起，因为代码运行出错，光标停在了此处，我就加了个S,仍不行。我发贴请教时忘了去掉就粘了上来，真不好意思 大哥，你这是在坑我啊
WORD的代码，怎么在EXCEL程序中调试啊！
如果必需在EXCEL中运行此代码，请参考：
'运行此代码前,请确认VBE/工具/引用中,勾选对于MICROSOFT WORD 10.0 OBJECT LIBRARY(版本不同,10.0的值不同,2003为11.0)
Option Explicit
Sub Example2() '此代码功能为列出指定文件夹中所有选取的WORD文件全路径名
'运行此代码前,请确认VBE/工具/引用中,勾选对于MICROSOFT WORD 10.0 OBJECT LIBRARY(版本不同,10.0的值不同,2003为11.0)
Dim WdApp As New Word.Application
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, A As Byte, MyDoc As Word.Document
Dim OldName As String, NewName As String, MyRange As Word.Range
On Error Resume Next '忽略错误
'定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set MyDoc = WdApp.Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
OldName = vrtSelectedItem '取得原文件名
' Debug.Print OldName
For A = 1 To 10 '循环
Set MyRange = MyDoc.Paragraphs(A).Range
If Len(MyRange.Text) > 1 Then Exit For '如果该段落文本长度大小于(非空白段落),则退出循环
Next
If MyRange.Information(wdWithInTable) Then
'如果在表格中,则去除最后两个字符
NewName = Mid(MyRange.Text, 1, Len(MyRange.Text) - 2)
Else
'如果为正常段落不在表格中,则去除最后一个段落标记
NewName = Mid(MyRange.Text, 1, Len(MyRange.Text) - 1)
End If
MyDoc.Close False '关闭文件
'去除空格
NewName = VBA.Trim(NewName)
'重新定义新的文件名
NewName = .InitialFileName & NewName
'如果已经存在该文件名,则加上时间数,加以区别
If Dir(NewName & ".Doc", vbDirectory) <> "" Then NewName = NewName & Timer
'重命名该文件
Name OldName As NewName & ".Doc"
Next
WdApp.Quit '关闭WORD程序
Set WdApp = Nothing '释放对象变量
End If
End With
End Sub
'---------------------- |
楼主: bth168
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2005-8-10 13:37
