Question

我有一个小问题。当我从Excel中创建一个文档到Excel中的单词时，需要取消隐藏工作表。如果我想“隐藏”此表，我该如何创建此报告。

代码：

    Sub Createrapport()

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


    Dim wdApp As Object
    Dim wd 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
    wdApp.Selection.TypeText ThisWorkbook.ActiveSheet.Range("I4").Text
    wdApp.ActiveWindow.ActivePane.View.SeekView = 0

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


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


Set rng = ThisWorkbook.ActiveSheet.Range("A1:E81")

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


End Sub

已修改版本

 Sub Createrapport()

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


    Dim wdApp As Object
    Dim wd 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
    wdApp.Selection.TypeText ThisWorkbook.ActiveSheet.Range("I4").Text
    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:E81")

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


End Sub

第二次编辑

  Sub Createrapport()

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


    Dim wdApp As Object
    Dim wd 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
    wdApp.Selection.TypeText ThisWorkbook.Worksheets("Rapport").Range("I4").Text
    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:E100")

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


End Sub

Answer 1

ThisWorkbook.ActiveSheet.Range("H11:M41").Copy

如果隐藏表单，则表单不会处于活动状态。您可以直接按名称参考表格：

Worksheets("Rapport").Range("H11:M41").Copy

根据MS复制应该从隐藏的工作表中工作。它适用于Excel，但在粘贴到其他Office应用程序时不可靠。我会取消隐藏，然后隐藏工作表。

更新的代码（在OP中）仍然引用ActiveSheet，它不会成为Rapport，因此剪贴板内容可能是空的。此

wdApp.Selection.TypeText ThisWorkbook.ActiveSheet.Range("I4").Text

应该是

wdApp.Selection.TypeText ThisWorkbook.Worksheets("Rapport").Range("I4").Text

但是，用户名是I1，而不是I4。

在Word中，您无法使用Excel数据自行使用Paste。您需要使用多种PasteSpecial方法之一，例如：

wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
    :=wdInLine, DisplayAsIcon:=False

在Word中录制宏以发现其他PasteSpecial选项。

在Word中录制宏，并使用默认的粘贴，提供以下代码：

    wdApp.Selection.PasteExcelTable False, False, False

从Excel创建Word中的报表

1 个答案: