需求：

    前述文章已經從諧響應仿真計算后處理中，創建了結果txt文檔和掃頻曲線圖。本節給出如何將計算結果填充到word 報告中，實現仿真報告的自動創建。

操作方法：

    利用word 和 excel 的VBA編輯功能，以excel為控制界面，調用word模板，讀取txt結果數據，創建報告。

示例說明：

    以excel作為控制界面，本例需要在excel內確定三個輸入參數：

1、word報告的標題。

2、零件的名稱（對應仿真結果提取body1的名稱）。

3、結果文件位置（仿真計算完成后默認路徑是仿真計算文件中）。

    點擊“創建報告”按鈕即可完成word 報告的自動創建。

操作說明：

1、 用戶需要在excel中設定三個輸入參數。

2、 本次示例需要在D盤設定test文件夾，其中包含word模板文件。

3、 生成的word報告文件是帶有宏命令的docm文件，可以另存docx文件。

4、 生成的word報告存儲在當前excel統計目錄下。

附錄：

Excel中的程序內容如下：

Sub harmonicReport()

titleName = Cells(7, 3).Value '讀取表格數據，作為word報告的標題

partName = Cells(8, 3).Value '讀取表格數據，作為word報告的零件名稱

resultFileDir = Cells(10, 3).Value '讀取表格數據，仿真計算結果的文件路徑

wordTemplateDir = "D:\test\template\template.docm" 'word模板位置

wordReportDir = ThisWorkbook.Path & "\" & titleName & ".docm" 'word報告位置，當前excel同級

Dim wordFSO As Object

Dim wordReport As Object

Const forReading = 1, forWriting = 2, forAppending = 8, tristateFalse = 0

Set wordFSO = CreateObject("scripting.FileSystemObject")

wordFSO.Copyfile wordTemplateDir, wordReportDir, True '復制word 模板

Set appWD = CreateObject("word.application")

Set wordReport = appWD.Documents.Open(wordReportDir)

appWD.Visible = True

appWD.Run "wordReport", titleName, partName, resultFileDir '調用word程序，傳遞三個參數

appWD.Documents.Save

'appWD.Quit

End Sub

Word中的調用程序如下所示：

Sub wordReport(titleName, partName, resultFileDir)

'******************************************************************

'*****************************Word報告創建*************************

'******************************************************************

' 01 參數設定

Dim aRange As Range

resultTxtDir = resultFileDir & "\00_harmResultrecord.txt"    '結果文件夾中的 txt文檔

harmonicSumX = getContent(resultTxtDir, "諧響應應力計算結果", 2) '讀取txt文檔中的最大應力值和頻率

picUseNum = 0

picName = resultFileDir & "\file" & Format(picUseNum, "000") & ".jpg" '結果文件夾中的 圖片file000

' 02 創建文檔標題和描述

Selection.EndKey Unit:=wdStory

Selection.InsertAfter titleName '仿真結果標題

Call formatTitle_B '轉2級標題格式，并轉接正文格式

Selection.InsertAfter "頻響分析是一種研究結構或系統在受到諧波激勵時的響應行為方法。**************"

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Call formatMain

' 03 創建結果統計表格

Selection.InsertAfter "下面給出計算結果示例："

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Selection.InsertAfter titleName & "結果統計表"

Call formatChartList

    '創建表格，2行、5列，列寬3.5

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _

5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed

Selection.Tables(1).Style = "網格型"

Selection.Tables(1).Select

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '至中

Selection.Cells.PreferredWidth = CentimetersToPoints(3.5) '列寬3.5

Selection.Tables(1).Cell(1, 1).Range.Text = "序號"

Selection.Tables(1).Cell(1, 2).Range.Text = "方向"

Selection.Tables(1).Cell(1, 3).Range.Text = "零件名稱"

Selection.Tables(1).Cell(1, 4).Range.Text = "響應頻率Hz"

Selection.Tables(1).Cell(1, 5).Range.Text = "應力值MPa"

Selection.Tables(1).Cell(2, 1).Range.Text = "1"

Selection.Tables(1).Cell(2, 2).Range.Text = "/"

Selection.Tables(1).Cell(2, 3).Range.Text = partName

Selection.Tables(1).Cell(2, 4).Range.Text = CSng(Val(Split(Split(harmonicSumX, "最大，頻率為")(1), "Hz")(0)))

Selection.Tables(1).Cell(2, 5).Range.Text = CSng(Val(Split(Split(harmonicSumX, "最大應力為")(1), "MPa")(0)))

Selection.EndKey Unit:=wdStory

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

' 04 創建結果應力響應圖形

Selection.InsertAfter "下面給出計算結果應力曲線示例："

Call formatMain

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

'表格中插入調整圖片大小

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Set aRange = Selection.Range

Selection.InlineShapes.AddPicture fileName:=picName '插入圖片

aRange.SetRange Start:=aRange.Start, End:=Selection.End

aRange.Select

With Selection.InlineShapes(1)

.LockAspectRatio = msoFalse '取消鎖定圖片縱橫比

.Height = 7 * 28.3378 '設置高度為9cm，1cm = 28.3378 pt

.Width = 10 * 28.3378 '設置寬度為12cm

End With

Selection.EndKey Unit:=wdLine

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Selection.InsertAfter titleName & "應力曲線"

Call formatPictureList

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

End Sub

Function getContent(txtDir, keyWord, line) As String

'*************************讀取txt關鍵字keyWord之后的第N行內容并返回****************

'*1.文檔地址；2.所屬關鍵字段；3.信息所在行數；return.返回行內容

Dim txtFSO As Object

Dim txtOpen As Object

Set txtFSO = CreateObject("scripting.FileSystemObject")

Set txtOpen = txtFSO.opentextfile(txtDir, 1, False)

For i = 1 To 300

temp = txtOpen.Readline

If temp = keyWord Then

For j = 1 To line

getContent = txtOpen.Readline

Next j

Exit For '退出大循環

End If

Next i

txtOpen.Close

Set txtFSO = Nothing

Set txtOpen = Nothing

End Function

Sub formatMain()

'************************“轉圖表格式，居中 小五，黑體”*******************

Selection.Style = ActiveDocument.Styles("正文")

Selection.Font.Name = "宋體"

Selection.Font.Size = 10.5

Selection.Font.Name = "Times New Roman"

With Selection.ParagraphFormat

.LineSpacingRule = wdLineSpaceMultiple

.LineSpacing = LinesToPoints(1.25)

.FirstLineIndent = CentimetersToPoints(0.35)

.CharacterUnitFirstLineIndent = 2

End With

End Sub

Sub formatTitle_B()

'************************文檔格式控制——“二級目錄標題”*******************new*********************************************new********************************

'*******************************************************“下一行起始正文，五號”

Selection.Style = ActiveDocument.Styles("標題B")

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Selection.Style = ActiveDocument.Styles("正文")

With Selection.ParagraphFormat

.LineSpacingRule = wdLineSpaceMultiple

.LineSpacing = LinesToPoints(1.25)

.FirstLineIndent = CentimetersToPoints(0.35)

.CharacterUnitFirstLineIndent = 2

End With

Selection.Font.Name = "宋體"

Selection.Font.Size = 10.5

Selection.Font.Name = "Times New Roman"

End Sub

Sub formatPictureList()

'************************“轉圖表格式，居中 小五，黑體”*******************

Selection.Style = ActiveDocument.Styles("圖B")

Selection.Font.Name = "黑體"

Selection.Font.Size = 10

Selection.Font.Name = "Times New Roman"

With Selection.ParagraphFormat

.CharacterUnitFirstLineIndent = 0

.FirstLineIndent = CentimetersToPoints(0)

.Alignment = wdAlignParagraphCenter

.LineSpacingRule = wdLineSpaceMultiple

.LineSpacing = LinesToPoints(1.25)

End With

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Call formatMain

End Sub

Sub formatChartList()

'************************“轉圖表格式，居中 小五，黑體”*******************

Selection.Style = ActiveDocument.Styles("圖B")

Selection.Font.Name = "黑體"

Selection.Font.Size = 10

Selection.Font.Name = "Times New Roman"

With Selection.ParagraphFormat

.CharacterUnitFirstLineIndent = 0

.FirstLineIndent = CentimetersToPoints(0)

.Alignment = wdAlignParagraphCenter

.LineSpacingRule = wdLineSpaceMultiple

.LineSpacing = LinesToPoints(1.25)

End With

Selection.InsertAfter Chr(13)

Selection.EndKey Unit:=wdStory

Call formatMain

End Sub