c++ 将文件内容输出到word上_Excel向Word输出复杂图文

之前写过一篇如如何把Excel数据按格式输出至Word，有很多朋友提到了可以使用邮件合并功能。确实，简单的输出，完全没必要使用VBA，毕竟这个重器并不那么友好。后来有朋友提出了，需要把图片按格式输出至Word，于是才有了今天这个文章。

我们先来看看具体的需求场景。以工程建设为例，某些工程验收时候都需要附验收图片，如下图这种，就需要把图片输出至指定的位置。

第一、建立模板

这里比较关键的是图片部分，文字替换部分很简单。对于图片，在需要插入图片的位置插入一个模板图片，调整好相应尺寸。该模板图片无实际作用，仅仅只是为了获取定位而已。

二、制作数据表

三、归集引用图片

这一步主要是把图片全部放在指定的路径下，并按规则进行命名。以上面数据表为例，我们按照点位标号来命名。在此命名规则为：未封装照片前缀为A、封装后照片前缀为B、验收人现场照片前缀为C，然后使用前缀+点位编号来标识图片对应，如下图。

四、核心代码

Private Sub MakeDoc_Click()

On Error GoTo Err_cmdExportToWord_Click

Dim objApp As Object 'Word.Application

Dim objDoc As Object 'Word.Document

Dim strTemplates As String '模板文件路径名

Dim strFileName As String '将数据导出到此文件

Dim i As Integer

Dim employNo As String

Dim employlocation As String

Dim employdate As String

Dim left_a, top_a, width_a, height_a, left_b, top_b, width_b, height_b, left_c, top_c, width_c, height_c As Double

i = ActiveCell.Row

employNo = Cells(i, 1)

employaddress = Cells(i, 2)

employdate = Cells(i, 3)

With Application.FileDialog(msoFileDialogFilePicker)

.Filters.Add "word文件", "*.doc;*.docx", 1

.AllowMultiSelect = False

If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub

End With

'通过文件对话框生成另存为文件名

With Application.FileDialog(msoFileDialogSaveAs)

.InitialFileName = employNo

If .Show Then strFileName = .SelectedItems(1) Else Exit Sub

End With

'文件名必须包括“.doc”的文件扩展名，如没有则自动加上

If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"

'如果文件已存在，则删除已有文件

If Dir(strFileName) <> "" Then Kill strFileName

'打开模板文件

Set objApp = CreateObject("Word.Application")

objApp.Visible = True

Set objDoc = objApp.Documents.Open(strTemplates, , False)

Application.ScreenUpdating = False

For Each IShapes In ActiveDocument.InlineShapes '把ishape形状转化成inlineshape对象，否则无法编辑

IShapes.ConvertToShape

Next

'获取模板图形形状所在位置和尺寸，以便后面调用，此部分代码，根据自己喜好，酌情使用或不使用。

With ActiveDocument.Shapes(1)

left_a = .Left + 15

width_a = .Width

top_a = .Top + 210

height_a = .Height

.Visible = msoFalse

End With

With ActiveDocument.Shapes(2)

left_b = ActiveDocument.Shapes(1).Left + ActiveDocument.Shapes(1).Width + 30

width_b = .Width

top_b = .Top + 210

height_b = .Height

.Visible = msoFalse

End With

With ActiveDocument.Shapes(3)

left_c = .Left + 20

width_c = .Width

top_c = .Top + 425

height_c = .Height

.Visible = msoFalse

End With

'把图片全部加载到文档中

ActiveDocument.Shapes.AddPicture Filename:=ThisWorkbook.Path & "图片" & "A" & employNo & ".jpg", _

linktofile:=False, SaveWithDocument:=True

ActiveDocument.Shapes.AddPicture Filename:=ThisWorkbook.Path & "图片" & "B" & employNo & ".jpg", _

linktofile:=False, SaveWithDocument:=True

ActiveDocument.Shapes.AddPicture Filename:=ThisWorkbook.Path & "图片" & "C" & employNo & ".jpg", _

linktofile:=False, SaveWithDocument:=True

'调整加载后的图片尺寸和位置

With ActiveDocument.Shapes(4)

.Width = width_a

.Height = height_a

.Top = top_a

.Left = left_a

End With

With ActiveDocument.Shapes(5)

.Width = width_b

.Height = height_b

.Top = top_b

.Left = left_b

End With

With ActiveDocument.Shapes(6)

.Width = width_c

.Height = height_c

.Top = top_c

.Left = left_c

End With

'开始替换模板预置变量文本

With objApp.Application.Selection

.Find.ClearFormatting

.Find.Replacement.ClearFormatting

With .Find

.Text = "{$点位编号}"

.Replacement.Text = employNo

End With

.Find.Execute Replace:=wdReplaceAll

With .Find

.Text = "{$安装位置}"

.Replacement.Text = employaddress

End With

.Find.Execute Replace:=wdReplaceAll

With .Find

.Text = "{$日期}"

.Replacement.Text = employdate

End With

.Find.Execute Replace:=wdReplaceAll

End With

'将写入数据的模板另存为文档文件

objDoc.SaveAs strFileName, FileFormat:=12

objDoc.Saved = True

MsgBox "报告生成完毕！", vbYes + vbExclamation

Application.ScreenUpdating = True

Exit_cmdExportToWord_Click:

If Not objDoc Is Nothing Then objApp.Visible = True

Set objApp = Nothing

Set objDoc = Nothing

Set objTable = Nothing

Exit Sub

Err_cmdExportToWord_Click:

MsgBox Err.Description, vbCritical, "出错"

Resume Exit_cmdExportToWord_Click

End Sub

特别需要说明的是，本办法中采用了预置图片来定位图片的输出位置，实际使用中可以抛弃该办法，转而直接加载图片，然后再逐一设置图片格式和位置。