前几天有一个任务：根据EXCEL表格的内容写一个文字的说明，里面的信息在EXCEL中。由于EXCEL表格有时会做修改，造成频繁地修改说明文字。由此，我决定用VBA写程序将文字完成。

VBA用的是WORD VBA，引用EXCEL的Application对象，达到从EXCEL中提取数据的目的。

文章分类就放到ACCESS更奇妙版块吧。

http://s6/mw690/001lK57Yzy783wV13SJ95&690VBA生成文字的VBA程序" TITLE="利用WORD VBA生成文字的VBA程序" />

http://s2/mw690/001lK57Yzy783wV4O1H61&690VBA生成文字的VBA程序" TITLE="利用WORD VBA生成文字的VBA程序" />

Option Explicit

Sub kkk()
    Dim ExcelApp As Object
    Dim mybook As Object
    Dim mysht As Object
    Dim myword As Document
    Dim year(2 To 3) As String
    Dim i%, j%, curpar%
    Dim temp$
    Dim arr(1 To 3) As Integer

    Set ExcelApp = CreateObject("Excel.Application")
    Set mybook = ExcelApp.Workbooks.Open(ThisDocument.Path & "\2015-2016对比表格.xls")
    ExcelApp.Visible = True
    Set mysht = mybook.Sheets("Sheet1")
    Set myword = ThisDocument
    myword.Range.Delete
    year(2) = mysht.Cells(1, 2)
    year(3) = mysht.Cells(1, 3)
    myword.Paragraphs(1).Range.Text = "关于我队" & year(2) & "、" & year(3) & "工资发放情况对比的说明" & vbCrLf
    curpar = 1
    For i = 2 To 3
        myword.Paragraphs(curpar + 1).Range.Text = IIf(i = 2, "一、", "二、") & year(i) & "工资情况" & vbCrLf
        For j = 2 To 5
            temp = temp & mysht.Cells(j, 1) & mysht.Cells(j, i) & IIf(j = 2, "人，", IIf(j = 5, "元。", "元，"))
        Next j
        myword.Paragraphs(curpar + 2).Range.Text = year(i) & temp & vbCrLf
        temp = "正式工中的" & mysht.Cells(4, i) & "元中，政策性增资包括："
        For j = 6 To 11
            If mysht.Cells(j, i) > 0 Then
                temp = temp & Right(mysht.Cells(j, 1), Len(mysht.Cells(j, 1)) - 6) & mysht.Cells(j, i) & "元，"
            End If
        Next j
        temp = temp & mysht.Cells(12, 1) & mysht.Cells(12, i) & "元。"
        temp = temp & "扣除政策性增资的正式工工资为：" & mysht.Cells(4, i) & "-" & mysht.Cells(12, i) & "=" & mysht.Cells(13, i) & "元。"
        myword.Paragraphs(curpar + 3).Range.Text = temp & vbCrLf
        myword.Paragraphs(curpar + 4).Range.Text = mysht.Cells(15, 1) & "为：" & mysht.Cells(4, i) & "÷" & mysht.Cells(2, i) & "=" & mysht.Cells(15, i) & "元。" & vbCrLf
        myword.Paragraphs(curpar + 5).Range.Text = mysht.Cells(16, 1) & "为：" & mysht.Cells(13, i) & "÷" & mysht.Cells(2, i) & "=" & mysht.Cells(16, i) & "元。" & vbCrLf
        curpar = myword.Paragraphs.Count - 1
        temp = ""
    Next i
    myword.Paragraphs(curpar + 1).Range.Text = "三、正式工两年工资对比" & vbCrLf
    myword.Paragraphs(curpar + 2).Range.Text = "1、总收入情况" & vbCrLf
    arr(1) = 4
    arr(2) = 12
    arr(3) = 13
    For i = 1 To 3
        curpar = myword.Paragraphs.Count - 1
        temp = "2016年" & mysht.Cells(arr(i), 1) & "为" & mysht.Cells(arr(i), 3) & "元，比2015年的" & mysht.Cells(arr(i), 2) & "元增加了" & mysht.Cells(arr(i), 4) & "元，增加了" & Format(mysht.Cells(arr(i), 5), "0.00%") & "。" & vbCrLf
        myword.Paragraphs(curpar + 1).Range.Text = temp
    Next i
    myword.Paragraphs(curpar + 2).Range.Text = "2、人均收入情况" & vbCrLf
    arr(1) = 15
    arr(2) = 14
    arr(3) = 16
    For i = 1 To 3
        curpar = myword.Paragraphs.Count - 1
        temp = "2016年" & mysht.Cells(arr(i), 1) & "为" & mysht.Cells(arr(i), 3) & "元，比2015年的" & mysht.Cells(arr(i), 2) & "元增加了" & mysht.Cells(arr(i), 4) & "元，增加了" & Format(mysht.Cells(arr(i), 5), "0.00%") & "。" & vbCrLf
        myword.Paragraphs(curpar + 1).Range.Text = temp
    Next i
    myword.Paragraphs(curpar + 2).Range.Text = vbCrLf & vbCrLf & "河北省煤田地质局第二地质队人事科" & vbCrLf
    curpar = myword.Paragraphs.Count - 1
    myword.Paragraphs(curpar + 1).Range.Text = Format(Now, "yyyy年M月d日")
    mybook.Close
    ExcelApp.Quit
    Set mysht = Nothing
    Set mybook = Nothing
    Set ExcelApp = Nothing

    myword.Range.Style.Font.Size = 14
    myword.Range.ParagraphFormat.CharacterUnitFirstLineIndent = 2
    myword.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    myword.Paragraphs(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    myword.Paragraphs(1).Range.Font.Size = 20
End Sub