将格式化的Excel数据透视表插入Word

如何解决将格式化的Excel数据透视表插入Word

我在Word中制作了一个放置书签的模板。我的想法是直接从Excel导出到此模板。

我每周将数据从CSV导入到恒定的Excel模板中。我将数据从Excel导出到Word文档，这是一个模板，其中包含插入数据的选定区域。

此过程有效，但是我厌倦了使用可见过滤器导入数据透视表（数据透视表中的过滤器甚至放置在数据透视表上方）。我在Word中手动删除了这些行。这本身不是一个大问题，但是我敢肯定这可以自动解决，以便导入枢轴表时无需此“过滤器行”。

我在网上找到了代码，可以按照自己的方式插入数据透视表。我没有能力重写代码。

下面的代码插入数据透视表：

Sub PivotTablePaste ()
    Dim SourcePivottable As PivotTable
    Dim DestinationRange As Range
    Dim aCell As Range
    
    Set SourcePivottable = Worksheets ("Sheet1"). PivotTables (1)
    Set DestinationRange = Worksheets ("Sheet1"). Range ("P1")
    
    'Copy TableRange1
    SourcePivottable.TableRange1.Copy
    With DestinationRange.Offset (_
      SourcePivottable.TableRange1.Row - SourcePivottable.TableRange2.Row,0)
        .PasteSpecial Paste: = xlPasteValues
        .PasteSpecial Paste: = xlPasteFormats
        .PasteSpecial Paste: = xlPasteColumnWidths
    End With
    
    'Copy everything above TableRange1 cell-by-cell
    For Each aCell In SourcePivottable.TableRange2.Cells
        If Not Intersect (aCell,SourcePivottable.TableRange1) Is Nothing Then Exit For
        aCell.Copy
        With DestinationRange.Offset (_
          aCell.Row - SourcePivottable.TableRange2.Row,_
          aCell.Column - SourcePivottable.TableRange2.Column)
            .PasteSpecial Paste: = xlPasteValues
            .PasteSpecial Paste: = xlPasteFormats
        End With
    Next aCell
    
End Sub

这段代码是我自己的，除了从数据透视表中可见的过滤器行外，还完美地将Excel中的各个部分插入到Word中。

Option Explicit

Sub CreateBasicWordReport()

Dim Wdapp As Object
Dim savename As String
Dim FileXt As String

Set Wdapp = CreateObject("Word.Application")

With Wdapp
'.Visible = True
'.Activate

.Documents.Add "C:\Users\Jonas\Desktop\notattest\Ændringsnotat.docx"

Dim ws As Worksheet

Copy to clipboard
Set ws = Worksheets.Add
Sheets("Eksport - Opsummering").Select
ActiveSheet.PivotTables("PivotTable1").PivotSelect "",xlDataAndLabel,True
Selection.Copy
.Selection.Goto what:=-1,Name:="Styklistefase1"
.Selection.Paste
Set ws = Worksheets.Add
Sheets("Eksport - Opsummering").Select
ActiveSheet.PivotTables("PivotTable3").PivotSelect "",Name:="Styklistefase1a"
.Selection.Paste

savename = Environ("userProfile") & "\Desktop\Exceltest\Export-Ændringsnotat " & _
Format(Now,"yyyy-mm-dd hh-mm-ss") & ".docx"

.ActiveDocument.SaveAs2 savename

.ActiveDocument.Close
.Quit

End With

Set Wdapp = Nothing