使用vb调用vba在word中插入图片的代码

过程名：wdout

作用：使用定义好的模板，自动将其中的形如｛????｝的字符以字段中的内容替换，并将｛照片｝替换成照片。如果没有照片，则删除相应的替换字符。

参数：photofile——照片文件的路径字符串，为完整绝对路径。不判断文件是否存在，如果不存在将出错。

插入图片其实只有一句
wdApp.Selection.InlineShapes.AddPicture FileName:= _
            PhotoFile, LinkToFile:=False, SaveWithDocument:= _
            True
可以用word的宏记录取得相应的代码。

Private   Function  WdOut(ByVal PhotoFile  As   String )
' '{单位}{费用名称}{费用名细}{大写金额}{金额}{鉴定单位}{经办人}{日期}

Dim  wdApp  As   Object , wdDoc  As   Object
Dim  i  As   Integer

If  CheckWord  =   False   Then
     MsgBox   " 没有安装Word软件或软件安装错误！ " , vbExclamation
     Exit   Function
End   If

If  DotName  =   ""   Or   Not  FileExist(DotName)  Then
         MsgBox   " 没有找到打印模板，无法打印！！ " , vbExclamation
         Exit   Function
End   If

MsgWinShow  " 正在从模板生成文档... "


' 'If Not wdDoc Is Nothing Then
' '    On Error Resume Next
' '    wdDoc.Close wdDoNotSaveChanges
' '    Set wdDoc = Nothing
' '    wdApp.Quit
' '    Set wdApp = Nothing
' '    On Error GoTo 0
' 'End If
' '

Set  wdApp  =   CreateObject ( " Word.Application " )
With  wdApp
'     .Visible = True
     Set  wdDoc  =  .Documents.Add(DotName,  False ,  0 ,  True )          ' 'wdNewBlankDocument=0
End   With

For  i  =   0   To  adoRS.Fields.Count  -   1
     ' With .Content.Find
    
     Select   Case  adoRS.Fields(i).Name
     Case   " 照片 "
        wdApp.Selection.Find.ClearFormatting
         With  wdApp.Selection.Find
            .Text  =   " {照片} "
            .Replacement.Text  =   " A "
            .Forward  =   True
            .Wrap  =  wdFindContinue
            .Format  =   False
            .MatchCase  =   False
            .MatchWholeWord  =   False
            .MatchByte  =   True
            .MatchWildcards  =   False
            .MatchSoundsLike  =   False
            .MatchAllWordForms  =   False
         End   With
        
        wdApp.Selection.Find.Execute
        wdApp.Selection.Delete Unit: = 1 , Count: = 1              ' '删除        1=wdCharacter
        
     If  PhotoFile  >   ""   Then
        wdApp.Selection.InlineShapes.AddPicture FileName: =  _
            PhotoFile, LinkToFile: = False , SaveWithDocument: =  _
             True
        wdApp.Selection.MoveLeft Unit: = wdCharacter, Count: = 1
        wdApp.Selection.MoveRight Unit: = wdCharacter, Count: = 1 , Extend: = wdExtend
        wdApp.Selection.InlineShapes( 1 ).Fill.Visible  =   0          ' '0= msoFalse
        wdApp.Selection.InlineShapes( 1 ).LockAspectRatio  =   - 1      ' '-1= msoTrue
        wdApp.Selection.InlineShapes( 1 ).Height  =   28   *   4.1
        wdApp.Selection.InlineShapes( 1 ).Width  =   28   *   2.8
     End   If
     Case   Else
    
     With  wdApp.Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        
        .Text  =   " { "   &  adoRS.Fields(i).Name  &   " } "
        .Replacement.Text  =  adoRS.Fields(i).Value  &   ""
        .Forward  =   True
        .Wrap  =   1         ' '1=wdFindContinue
        .Format  =   False
        .MatchCase  =   False
        .MatchWholeWord  =   False
        .MatchByte  =   True
        .MatchWildcards  =   False
        .MatchSoundsLike  =   False
        .MatchAllWordForms  =   False
        .Execute  Replace : = 2       ' '2=wdReplaceAll
     End   With
    
     End   Select
Next
    wdApp.Visible  =   True
    
Set  wdDoc  =   Nothing
Set  wdApp  =   Nothing


MsgWinHide

End Function