使用 Excel 到 Word 宏的文本缩进

Question

我有一个 Excel 到 Word 宏，指定如下：

Sub CopyToWordDoc()


Dim objWord
Dim objDoc
Dim objSel
Dim sht As Worksheet
Dim p As Integer

Set objWord = CreateObject("Word.Application") 'open new word document
Set objDoc = objWord.Documents.Add
Set objSel = objWord.Selection

objWord.Visible = True

For x = 1 To Worksheets.Count - 1 'loop through data sheets and export contents to Word
    On Error Resume Next
    Set sht = Sheets("X" & x)
    On Error GoTo 0
    If sht Is Nothing Then Exit Sub

    With sht
        If x = 1 Then 'add version, date, userinfo, projectinfo etc. to first page of Word
            objSel.Style = objDoc.Styles("Heading 1")
            objSel.TypeText (Range("Client").Value2)
            objSel.TypeParagraph

            objSel.Style = objDoc.Styles("Heading 1")
            objSel.TypeText ("Scope of Tax Due Diligence")
            objSel.TypeParagraph
            objSel.Style = objDoc.Styles("Normal")
            objSel.TypeText ("Review Period: " & Range("Period").Value2)
            objSel.TypeParagraph

            If .Range("C3").Value2 = True Then 'check if Level 1 titel has to be added
                objSel.Style = objDoc.Styles("Heading 2")
                objSel.TypeText (.Range("B2").Value2)
                objSel.TypeParagraph
            Else
                p = 1
            End If
        Else
            If p = 1 And .Range("C3").Value2 = True Then
                objSel.Style = objDoc.Styles("Heading 2")
                objSel.TypeText (.Range("B2").Value2)
                objSel.TypeParagraph
                p = 0
            ElseIf p = 0 And .Range("C3").Value2 = True Then
                If .Range("B2").Value2 <> Sheets("X" & x - 1).Range("B2").Value2 Then
                    objSel.Style = objDoc.Styles("Heading 2")
                    objSel.TypeText (.Range("B2").Value2)
                    objSel.TypeParagraph
                End If
            ElseIf p = 0 And .Range("C3").Value2 = False Then
                If .Range("B2").Value2 <> Sheets("X" & x - 1).Range("B2").Value2 Then p = 1
            End If
        End If

        objWord.Run MacroName:="sdWordEngine.mBulletsAndNumbering.FormatBulletDefault"

        If .Range("C3").Value2 = True Then 'add level 2 title
            objSel.Style = objDoc.Styles("Heading 3")
            objSel.TypeText (.Range("B3").Value2)
            objSel.TypeParagraph
        End If

        objWord.Run MacroName:="sdWordEngine.mBulletsAndNumbering.FormatBulletDefault"



        For y = 4 To Application.WorksheetFunction.CountA(.Range("B1:B50")) 'loop through data sheet and add info if in scope

            If .Range("C" & y).Value2 = True Then
                If .Range("A" & y).Value2 = 3 Then
                    objSel.Range.SetListLevel Level:=1
                    objSel.TypeText (.Range("B" & y).Value2)
                    objSel.TypeParagraph
                Else
                    objSel.Range.SetListLevel Level:=2
                    objSel.TypeText (.Range("B" & y).Value2)
                    objSel.TypeParagraph
                End If
            End If
        Next
    End With
Next

objWord.Run MacroName:="sdWordEngine.mBulletsAndNumbering.FormatBulletDefault"
objSel.InsertBreak Type:=wdPageBreak

For x = 1 To Worksheets.Count - 1 'same as above but for info request instead
    On Error Resume Next
    Set sht = Sheets("X" & x)
    On Error GoTo 0
    If sht Is Nothing Then Exit Sub

    With sht
        If x = 1 Then
            objSel.Style = objDoc.Styles("Heading 1")
            objSel.TypeText ("Information Request for Tax Due Diligence")
            objSel.TypeParagraph

            If .Range("C3").Value2 = True Then
                objSel.Style = objDoc.Styles("Heading 2")
                objSel.TypeText (.Range("B2").Value2)
                objSel.TypeParagraph
            Else
                p = 1
            End If
        Else
            If p = 1 And .Range("C3").Value2 = True Then
                objSel.Style = objDoc.Styles("Heading 2")
                objSel.TypeText (.Range("B2").Value2)
                objSel.TypeParagraph
                p = 0
            ElseIf p = 0 And .Range("C3").Value2 = True Then
                If .Range("B2").Value2 <> Sheets("X" & x - 1).Range("B2").Value2 Then
                    objSel.Style = objDoc.Styles("Heading 2")
                    objSel.TypeText (.Range("B2").Value2)
                    objSel.TypeParagraph
                End If
            ElseIf p = 0 And .Range("C3").Value2 = False Then
                If .Range("B2").Value2 <> Sheets("X" & x - 1).Range("B2").Value2 Then p = 1
            End If
        End If

        objWord.Run MacroName:="sdWordEngine.mBulletsAndNumbering.FormatBulletDefault"

        If .Range("C3").Value2 = True And Application.WorksheetFunction.CountIf(.Range("G2:G50"), True) <> 0 Then
            objSel.Style = objDoc.Styles("Heading 3")
            objSel.TypeText (.Range("B3").Value2)
            objSel.TypeParagraph
        End If

        objWord.Run MacroName:="sdWordEngine.mBulletsAndNumbering.FormatBulletDefault"

        For y = 2 To Application.WorksheetFunction.CountA(.Range("F1:F50"))
           If .Range("C3").Value2 = True Then
                If .Range("G" & y).Value2 = True Then
                    If .Range("E" & y).Value2 = 1 Then
                        objSel.Range.SetListLevel Level:=1
                        objSel.TypeText (.Range("F" & y).Value2)
                        objSel.TypeParagraph
                    Else
                        objSel.Range.SetListLevel Level:=2
                        objSel.TypeText (.Range("F" & y).Value2)
                        objSel.TypeParagraph
                    End If
                End If
            End If
        Next
    End With
Next

objSel.TypeBackspace
objSel.WholeStory
objSel.Font.Name = "Arial"

End Sub

在 Excel 文件中，我将所有信息放在一个 Word 文档中：

Excel File picture

如何确保所有 4 级文本在 Word 中生成后的文本缩进约为 2 厘米？

提前，非常感谢您的支持！

---

所以我把下面的代码放进去：

For y = 4 To Application.WorksheetFunction.CountA(.Range("B1:B50")) '遍历数据表并在范围内添加信息

            If .Range("C" & y).Value2 = True Then
                If .Range("A" & y).Value2 = 4 Then
                    objSel.Range.SetListLevel Level:=1
                    objSel.TypeText (.Range("B" & y).Value2)
                    objSel.TypeParagraph
                    objSel.Paragraphs.LeftIndent = 72
                Else
                    objSel.Range.SetListLevel Level:=2
                    objSel.TypeText (.Range("B" & y).Value2)
                    objSel.TypeParagraph
                End If
            End If

当我编译 Word 文档时，它设置了 4 级行，左缩进 72。但是，只有从第二个 4 级行开始，它才开始以这种方式格式化行。它总是省略第一级 4 行（保持它没有左缩进）。有人知道这是为什么吗？非常感谢您的帮助！

Answer 1

怎么样：

Selection.Paragraphs.LeftIndent = 72

更改 72 以适合您想要的。 选择整个文档，然后将那行代码放在它后面。

http://word.tips.net/T001468_Setting_the_Left_Indent_of_a_Paragraph_in_a_Macro.html