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

在Excelfile中，我将所有信息放在Word文档中：

Excel File picture

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

事先，非常感谢您的支持！

所以我把以下代码放在：

对于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文档时，它使用左缩进72设置4级行。但是，仅从第2级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

使用Excel到Word宏的文本缩进

1 个答案: