Question

您可以使用以下代码将Excel中的值导出到Word文档中：

 Sub Createrapport()
    Dim WS As Worksheet

    Set WS = Worksheets("Rapport")
    Application.ScreenUpdating = False
        Sheets("Rapport").Visible = True

    Dim UserName As String
    UserName = InputBox(Prompt:="Var vänligen och ange ditt namn nedan:")
    If UserName = vbNullString Then
    Exit Sub
    Else
    WS.Range("I1").Value = UserName
    End If

        Dim wdApp As Object
        Dim wd As Object
        Dim Tbl As Object

        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err.Number <> 0 Then
            Set wdApp = CreateObject("Word.Application")
        End If
        On Error GoTo 0

        Sheets("Rapport").Activate
        Set wd = wdApp.Documents.Add
        wdApp.Visible = True

        'sidhuvud
        wdApp.ActiveWindow.ActivePane.View.SeekView = 9
        With wd
            Set Tbl = .tables.Add(wdApp.Selection.Range, 2, 3, wdWord8TableBehavior)
            Tbl.cell(1, 1).Range.Text = WS.Range("K4").Text
            Tbl.cell(1, 2).Range.Text = WS.Range("L4").Text
            Tbl.cell(1, 3).Range.ParagraphFormat.Alignment = 2 'wdAlignParagraphRight
            Tbl.cell(1, 3).Range.Text = WS.Range("I1").Text
            Tbl.cell(2, 1).Range.Text = WS.Range("K5").Text
            Tbl.cell(2, 3).Range.ParagraphFormat.Alignment = 2 'wdAlignParagraphRight
            Tbl.cell(2, 3).Range.Text = WS.Range("M5").Text
        End With
        wdApp.ActiveWindow.ActivePane.View.SeekView = 0

        'sidnummer
        'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  ", PreserveFormatting:=True

        '***** copy image from cell H11:M411 in Excel
        Worksheets("Rapport").Range("H11:M41").Copy
        '***** past image at the current position in Word
        wdApp.Selection.Paste

    Set rng = Worksheets("Rapport").Range("A1:E203")

    rng.Copy
       With wd.Range
            .collapse Direction:=0                  'Slutet av dokumentet
            .InsertParagraphAfter                   'Lägg till rad
            .collapse Direction:=0                  'Slutet av dokumentet
            .PasteSpecial False, False, True        'Pasta som Enhanced Metafile
       End With
       Sheets("Rapport").Visible = False
       Application.ScreenUpdating = True


Set newDoc = Documents.Add
Set myTable = _
    newDoc.Tables.Add(Range:=Selection.Range, NumRows:=3, _
    NumColumns:=3)
myTable.Cell(2, 1).SetWidth _
    ColumnWidth:=InchesToPoints(1.5), _
    RulerStyle:=wdAdjustNone

    End Sub

然后获得的报告如下：

sample picture

如何使值适合word文档的边距？这是执行它的prt，它是＆＃34; InchesToPoints（1.5）＆＃34;哪个错误：

Set newDoc = Documents.Add
    Set myTable = _
        newDoc.Tables.Add(Range:=Selection.Range, NumRows:=3, _
        NumColumns:=3)
    myTable.Cell(2, 1).SetWidth _
        ColumnWidth:=InchesToPoints(1.5), _
        RulerStyle:=wdAdjustNone

已编辑的代码

Set newDoc = Documents.Add
        Set myTable = _
    newDoc.Tables.Add(Range:=Selection.Range, NumRows:=3, _
    NumColumns:=3)
'***** Word constant wdPreferredWidthPercent = 2
myTable.PreferredWidthType = 2
myTable.PreferredWidth = 100
    myTable.Cell(2, 1).SetWidth _
        ColumnWidth:=InchesToPoints(1.5), _
        RulerStyle:=wdAdjustNone

Answer 1

通过google的魔力找到：

Selection.Tables(1).PreferredWidthType = wdPreferredWidthPercent
Selection.Tables(1).PreferredWidth = 100

说Word 2000，在Word 2010中试用过。

（在您的情况下，您可能需要在wdApp.对象之前添加Selection，并确保Selection指向表所在文档中的位置。）

修改

我的代码示例已更新，以符合您更新的代码：

'***** Word constant wdPreferredWidthPercent = 2 myTable.PreferredWidthType = 2 myTable.PreferredWidth = 100

将其放在Set myTable =行之后。

编辑2

VBA中的下划线意味着一个代码行延伸到多行，因此您无法在两者之间放置代码（如果那是不起作用的话）。

上下文中的代码示例：

Set myTable = _ newDoc.Tables.Add(Range:=Selection.Range, NumRows:=3, _ NumColumns:=3) '***** Word constant wdPreferredWidthPercent = 2 myTable.PreferredWidthType = 2 myTable.PreferredWidth = 100

编辑3

Set newDoc = wdApp.Documents.Add Set myTable = _ newDoc.Tables.Add(Range:=wdApp.Selection.Range, NumRows:=3, _ NumColumns:=3) '***** Word constant wdPreferredWidthPercent = 2 myTable.PreferredWidthType = 2 myTable.PreferredWidth = 100 myTable.Cell(2, 1).SetWidth _ ColumnWidth:=wdApp.InchesToPoints(1.5), _ RulerStyle:=0 '*****wdAdjustNone

Answer 2

试试这个：

myTable.AutoFitBehavior wdAutoFitWindow

如果你迟到了：

myTable.AutoFitBehavior 2

这将在word文档边距内自动调整表格这是你正在尝试的吗？

从Excel创建报告到Word

2 个答案: