Private Sub Command1_Click()
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists("c:\a.txt") Then
    MsgBox "a.txt is not exist!"
    Exit Sub
End IfConst ForReading = 1
Set txtFile = objFSO.OpenTextFile("c:\a.txt", ForReading)
strLine = txtFile.ReadlineDim tmp
tmp = Split(strLine, "@")
Dim docApp
Set docApp = CreateObject("Word.Application")
docApp.Visible = True
Set qq = docApp.Documents.Open("C:\abc\dong\qq.doc")
Set doc1 = docApp.Documents.Open(tmp(1))
doc1.Activate
docApp.Selection.WholeStory
docApp.Selection.Copy
qq.Activate
docApp.Selection.WholeStory
docApp.Selection.PastedocApp.Selection.Find.ClearFormatting
    With docApp.Selection.Find
        .Text = "[姓名]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = 1
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
    End With
docApp.Selection.Find.Execute
docApp.Selection.TypeText tmp(0)qq.Save
qq.Close
doc1.CloseSet qq = Nothing
Set doc1 = Nothing
docApp.Quit
Set docApp = Nothing
Set objFSO = NothingEnd Sub以上代码可以实现
在C盘有个文件,例如c:\a.txt文件,这个文件有这样的数据:C:\a\11.jpg@C:\abc\dong\姓名表.doc;还有另外一个C:\abc\dong\qq.doc,这个qq.doc是个没有数据的word,也就是空白的word。
在这个姓名表.doc里有一个中括号,中括号里有[姓名] 。以上代码可以实现把C:\a\11.jpg替换[姓名]
但现在怎么把C:\a\11.jpg的这张图片显示并替换在姓名表.doc里的[姓名]?

解决方案 »

  1.   

    插入图片:
     myDoc.InlineShapes.AddPicture FileName:= _
            "C:\a\11.jpg" _
            , LinkToFile:=False, SaveWithDocument:=True
      

  2.   

    faysky2()  你能讲的详细点吗!还有c:\a.txt文件里的数据会经常变的例如:C:\a\88.jpg@C:\abc\dong\姓名表.doc
      

  3.   

    还有c:\a.txt文件里的数据会经常变的
    -------------------------------------
    这个不会有多大的影响,只要读取c:\a.txt的内容,以@为标志,将其内容分为两部分(分别为C:\a\88.jpg和C:\abc\dong\姓名表.doc),然后打开C:\abc\dong\姓名表.doc,将其里面的[姓名]替换为C:\a\88.jpg这张图片Private Sub Command1_Click()
        Dim strPic As String, strFile As String, strTemp As String
        Open "c:\a.txt" For Input As #1
        Line Input #1, strTemp
        Close #1
        strPic = Left(strTemp, InStr(strTemp, "@") - 1)  '得到C:\a\88.jpg
        strFile = Mid(strTemp, InStr(strTemp, "@") + 1)  '得到C:\abc\dong\姓名表.doc    Dim docApp As New Word.Application
        docApp.Visible = True
        Dim doc As New Word.Document
        Set doc = docApp.Documents.Open(strFile)  '打开C:\abc\dong\姓名表.doc
        
        docApp.Selection.WholeStory
        docApp.Selection.Find.ClearFormatting
        With docApp.Selection.Find
            .Text = "[姓名]"
            .Replacement.Text = ""
        End With
        docApp.Selection.Find.Execute
        docApp.Selection.InlineShapes.AddPicture strPic,False, True  '插入C:\a\88.jpg图片
        docApp.DisplayAlerts = wdAlertsNone
        doc.Close True  '关闭并保存对Word所做的改变
        docApp.Quit
        Set doc = Nothing
        Set docApp = Nothing
    End Sub
      

  4.   

    去 http://www.eightbird.com/ 看一下 typhoonGraph.ocx 控件是否适合用。