过程名：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
本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/lanman/archive/2008/04/09/2265650.aspx
