kopieren dynamische Bereiche von Excel zu Wort VBA

Question

Ich habe ein Datenblatt und der Bereich variieren jede Woche Bedeutung zuletzt verwendete Zeile und zuletzt verwendete Spalte variieren. Ich hoffe, 3 Bereiche gleichzeitig zu kopieren und es als Bild in Wort mit VBA einzufügen. Dies ist Teil eines größeren Codes, deshalb hoffe ich, es zu erreichen, indem ich VBA schreibe.

Der Grund hinter 3 Bereichen gleichzeitig ist, weil die Bildgröße am besten in Wort passt. Die Header werden in Zeile 2 und 3 zusammengeführt. Ich zeige Ihnen 4 Bereiche, aber manchmal bekomme ich 2 Bereiche und manchmal 6 Bereiche. d. h. 3 Bereiche oder darunter sollten nur ein Bild sein und von 4-6 Bereichen bedeutet, dass ich 2 Bilder in Wort habe.

Gerade jetzt, wenn ich meine Codes ausführen, wird nichts in Wort eingefügt.

Sub Table() 

    Dim wdapp As Word.Application 
    Set wdapp = New Word.Application 

    With wdapp 
     .Visible = True 
     .Activate 
     .Documents.Add 
    End With 

    With ThisWorkbook.Worksheets("Table") 
     Dim a, b, c, RR As Range 
    '1 
     Set a = .Cells.Find("Header1", LookIn:=xlValues) 

     If Not a Is Nothing Then 
      Dim firstAddress As String 
      firstAddress = a.Address 
      Do 
' 2 
    Set b = .Cells.Find("Header1", a, LookIn:=xlValues) 
' 3 
    Set c = .Cells.Find("Header1", b, LookIn:=xlValues) 
'Union 
Set RR = Union(Range(a.End(xlDown).End(xlDown), a.Resize(, 7)), Range(b.End(xlDown).End(xlDown), b.Resize(, 7)), Range(c.End(xlDown).End(xlDown), a.Resize(, 20))) 
    RR.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
       wdapp.Selection.Paste 
       Set a = .UsedRange.FindNext(a) 
       If a Is Nothing Then Exit Do 
      Loop While a.Address <> firstAddress 


     End If 
    End With 

End Sub 

Answer 1

Es gibt ein paar Probleme hier:

• Nested With s sind in der Regel ein schlechter Plan, und scheint in diesem Beispiel
• ziemlich planlos zu sein Find nicht in Zeilen suchen mag, die Teil enthält von Zellen verschmolzen, so ist es am besten, sich nur auf das gesamte Blatt
• .End(xlDown) aus einer fusionierten Zelle auswählt finden benutzen sie einfach die nächste gebrauchte Zelle beolw es, nicht den ganzen Block, so müssen wir diese zweimal
• Ihre Schleife condi anzuwenden Wenn dNothing ist, wird es einen Fehler erzeugen, da es immer noch versucht, seine Adresse zu überprüfen. Überprüfen Sie, ob Nothing erste und brechen aus der Schleife benötigt, wenn

Alle gesagt, dies sollte funktionieren Ich glaube:

Option Explicit 

Sub Table() 

    Dim wdapp As Word.Application 
    Set wdapp = New Word.Application 

    With wdapp 
     .Visible = True 
     .Activate 
     .Documents.Add 
    End With 

    With ThisWorkbook.Worksheets("Table") 
     Dim d As Range 
     Set d = .Cells.Find("Header1", LookIn:=xlValues) 
     If Not d Is Nothing Then 
      Dim firstAddress As String 
      firstAddress = d.Address 
      Do 
       .Range(d, d.End(xlDown).End(xlDown).End(xlToRight)).CopyPicture Appearance:=xlScreen, Format:=xlPicture 
       wdapp.Selection.Paste 
       Set d = .UsedRange.FindNext(d) 
       If d Is Nothing Then Exit Do 
      Loop While d.Address <> firstAddress 
     End If 
    End With 

End Sub 

Für den speziellen Fall des Wunschs die ersten drei Blöcke als ein Bild einzufügen, und die vierte als ein separates Bild, können Sie die Do-Schleife mit ersetzen:

.Range(d, d.End(xlDown).End(xlDown).End(xlToRight).End(xlToRight).End(xlToRight).End(xlToRight).End(xlToRight)).CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    wdapp.Selection.Paste 
    Dim i As Long 
    For i = 1 To 3 
     Set d = .UsedRange.FindNext(d) 
    Next i 
    .Range(d, d.End(xlDown).End(xlDown).End(xlToRight)).CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    wdapp.Selection.Paste 

Answer 2

Ich habe gerade Ihre schwache Aussagen, da diese mit 2.016 auf Sieg nicht 7 arbeiten

Dim wdapp As Object 
Dim d As Range 
Set wdapp = CreateObject("Word.Application") 

Dann ist es funktionierte gut.