找到了word 宏程序出错的原因了。。。。_unikran

http://blog.sina.com.cn/u/1420869803

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

找到了word 宏程序出错的原因了。。。。

(2010-04-21 22:48:39)

标签：

移动宽带

it

分类：移动、宽带__博客张凯_unikran

Sub Note()

n = ActiveDocument.Name
n = n + " (只读)"
Selection.Copy

Dim aWord As Word.Application

j = "f:\" + "读书笔记" + Format(Now, "yyyymmdd") + ".doc"

On Error Resume Next

If Dir(j) <> "" Then

        Documents.Open FileName:=j, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

        Selection.TypeParagraph
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.TypeParagraph

        Selection.Find.ClearFormatting
        With ActiveDocument.Content.Find
        .Text = n
        .Forward = True
        .Execute


        If .Found = False Then
        Selection.TypeText Text:=n
        Else
        Selection.EndKey Unit:=wdStory
          Selection.Find.ClearFormatting
        With Selection.Find
        .Text = n
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.TypeText Text:=n
        End If

        End With


        Selection.EndKey Unit:=wdStory
        ActiveDocument.Save

        Windows(n).Activate

Else

        Set aWord = CreateObject("Word.Application")
        aWord.Visible = True
        aWord.Documents.Add
        aWord.ActiveDocument.SaveAs FileName:=j
        aWord.ActiveDocument.Close
        Set aWord = Nothing
        Documents.Open FileName:=j, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        Selection.TypeParagraph
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.TypeParagraph



         Selection.TypeText Text:=n



        Selection.EndKey Unit:=wdStory
        ActiveDocument.Save
        MsgBox n


        Documents.Open FileName:=j, ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
        Selection.TypeParagraph
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.TypeParagraph

        Windows(n).Activate

'出错的原因是因为文件名带+" (只读)"，所以出现

' 运行时错误‘5941’
'集合所要求的成员不存在。

因此要注意。。。

End If

End Sub

Sub sBaiduSearch()

'如果浏览器脱机工作, 则不正常.

    s1 = Selection


    x = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.baidu.com/s?wd=" + s1
    Shell (x)


    x1 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.iciba.com/" + s1
    Shell (x1)

    x2 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://baike.baidu.com/searchword/?word=" + s1 + "&pic=1&sug=1"
    Shell (x2)


    x3 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://zhidao.baidu.com/q?word=" + s1 + "&ct=17&pn=0&tn=ikaslist&rn=10&lm=0&fr=search"
    Shell (x3)





End Sub
Sub sdoubaiduSearch()

    '如果浏览器脱机工作, 则不正常.

    s1 = Selection


    x = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.baidu.com/s?wd=""" + s1 + """"
    Shell (x)


    x1 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.iciba.com/" + s1
    Shell (x1)

    'x2 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://baike.baidu.com/searchword/?word=""" + s1 + "&pic=1&sug=1"
    'Shell (x2)


   ' x3 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://zhidao.baidu.com/q?word=""" + s1 + """&ct=17&pn=0&tn=ikaslist&rn=10&lm=0&fr=search"
   ' Shell (x3)

    'x4 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://wenku.baidu.com/search?word=""" + s1 + """&lm=0&od=0"
    'Shell (x4)


    x5 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.google.com.hk/search?hl=zh-CN&newwindow=1&safe=strict&q=""" + s1 + """&meta=&aq=f&aqi=&aql=&oq=&gs_rfai="

    Shell (x5)


    x6 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=""" + s1 + """&lm=1"

    Shell (x6)




End Sub
Sub nsDiskSearch()

    '如果浏览器脱机工作, 则不正常.

    s1 = Selection




    x6 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=""" + s1 + """&lm=1"

    Shell (x6)

   ' x7 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=" + s1 + "&lm=1"

   ' Shell (x7)


End Sub
Sub sincibaSearch()

    s1 = Selection


    x1 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.iciba.com/" + s1
    Shell (x1)

End Sub
Sub BsinbaiduSearch()

    s1 = Selection


    x = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.baidu.com/s?wd=" + s1

   Shell (x)

End Sub
Sub Question()
n = ActiveDocument.Name
Selection.Copy

Dim Message, Title, Default, MyValue
Message = Selection          ' 设置提示信息。
Title = "Enter your ideas, views, or opinions....."    ' 设置标题。
Default = "问: ?"    ' 设置缺省值。
' 显示信息、标题及缺省值。
MyValue = InputBox(Message, Title, Default)

j = "e:\" + "读书笔记" + Format(Now, "yyyymmdd") + ".doc"

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim rFile As RecentFile
    For Each rFile In RecentFiles
       If rFile.Name = j Then Found = True
    Next rFile
If Found <> True Then

    If objFSO.FileExists(j) Then
        Documents.Open FileName:=j

          Selection.EndKey Unit:=wdStory
    Else
        Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    ActiveDocument.SaveAs FileName:=j, FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False

          Selection.EndKey Unit:=wdStory
    End If

Else
    Documents(j).Activate

          Selection.TypeParagraph
End If

    Selection.TypeParagraph
    Selection.PasteAndFormat (wdPasteDefault)
     Selection.TypeParagraph
   Selection.TypeText Text:=MyValue
   Selection.TypeParagraph

    ActiveDocument.Save
     Selection.EndKey Unit:=wdStory
    Documents(n).Activate

End Sub

Sub sinGOOGLE()
s1 = Selection


    x5 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://www.google.com.hk/search?hl=zh-CN&newwindow=1&safe=strict&q=""" + s1 + """&meta=&aq=f&aqi=&aql=&oq=&gs_rfai="

Shell (x5)

End Sub

Sub nsBLOGSearch()

'如果浏览器脱机工作, 则不正常.

    s1 = Selection




    x6 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=""" + s1 + """+folder%3A%28E%3A%5Cunikran%29&sr=0&lm=1&preword=&time=0&num=50&sort=0"

    Shell (x6)

   ' x7 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=" + s1 + "&lm=1"

' Shell (x7)

End Sub

Sub ns3GPPr6()

'如果浏览器脱机工作, 则不正常.

    s1 = Selection




    x6 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=""" + s1 + """%22+folder%3A%28E%3A%5C3GPPR6%29&lm=1"

    Shell (x6)

   ' x7 = "C:\Program Files\Internet Explorer\iexplore.exe " + "http://127.0.0.1:7887/search?word=" + s1 + "&lm=1"

' Shell (x7)

End Sub

Sub 宏1()

MsgBox "23G每天的工作都做什么？"

MsgBox "yes : 提取报表, "

End Sub

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：求visio2007下载

后一篇：解决了原始文件名与打开文件名不同的问题

新浪BLOG意见反馈留言板　欢迎批评指正