VBA: Makro in Excel das Tabelle in Word formatiert

[Joe]

Guten Tag,

ich habe einen Quellcode mit dem ich verschiedene Bereiche von Excel nach Word kopiere. Das Problem ist, das die Tabellen-Zeilen-Höhe zu groß ist.
Beim manuellen bearbeiten ist mir aufgefallen das die Zeilenhöhe zwar bei 0,5 cm ist, aber die Auswahl daneben auf "Mindestens" steht und
nicht auf "Genau". Bei "Genau" wäre die Formatierung genau so, wie ich sie haben will. Ich habe schon den Makrorecoder angeschaltet in Word und
den daraus resultierenden Code versucht in meinem Excel Code zu verarbeiten. Dies allerdings war nicht erfolgreich.

Lange Rede kurzer Unsinn, wie kann ich in Excel, nach dem er die ganzen Bereiche kopiert hat,
alle Tabellen in Word makieren und deren Zeilenhöhe auf "Genau" 0,5 cm machen.

Folgender Code kopiert die Bereiche nach Word:

Code:

Dim appWord As Object
Dim doc As Object
Dim wsa As Object
Dim wsb As Object
Dim wsc As Object


Set appWord = CreateObject("Word.Application")
Set doc = appWord.Documents.Add("T:\Vorlage.docx") '*** verwendet Datei nur als Vorlage ***
appWord.Visible = True

 Set wsa = ThisWorkbook.Worksheets("Tabelle1")
 Set wsb = ThisWorkbook.Worksheets("Tabelle2")
 Set wsc = ThisWorkbook.Worksheets("Tabelle3")
 
   With doc.Application.Selection
   
       If chk1 = True Then
            wsa.Range("A1:B5").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
        End If
        
       If chk2 = True Then
            wsb.Range("A1:C4").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
        End If
        
       If chk3 = True Then
            wsc.Range("A1:J31").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
       End If

Folgender Code ist aus dem Makrorecorder in Word:

Code:

Selection.WholeStory                                'makiert alles
Selection.Rows.HeightRule = wdRowHeightExactly      'setzt Zeilenhöhe auf genau
Selection.Rows.Height = CentimetersToPoints(0.5)    'setzt Zeilenhöhe auf 0,5 cm

PS: Falls möglich wäre es nett wenn ihr mir sagen könntet wie man die Zwischenablage entfernen kann nach dem Prozess, damit beim Schließen keine unnötigen Abfragen entstehen.


Mit freundlichen Grüßen

Joe

[snb]

Code:

Sub M_snb()
   With CreateObject("Word.document")
     For j = 1 To 3
        ThisWorkbook.Sheets("Tabelle" & j).Cells(1).CurrentRegion.Copy
        .Paragraphs.last.Range.PasteExcelTable False, False, False
        .Content.InsertAfter String(2, vbCr)
     Next

     For Each it In .tables
        it.Rows.HeightRule = 2
        it.Rows.Height = .Application.CentimetersToPoints(0.5)
      Next

      .Application.Visible = True 
   End With
End Sub

[Joe]

Guten Tag snb,

Danke für deine Lösung, könnte man den Code so verändern das die Grundstruktur wie in meinem Code beibehalten wird.
Der Grund ist, das ich mit VBA noch nicht vertraut bin und die einfache Struktur mit der If-Bedingung zum kopieren der Bereiche brauche.

Ich habe probiert einfach den Teil mit dem Kopieren von dir raus zu kürzen und den hinter meinem Code gelegt.
Leider öffnet er dadurch nur eine zusätzliche Word Datei.

Wie kann man am besten die beiden Codes verbinden?

Gruß Joe

Code:

Dim appWord As Object
Dim doc As Object
Dim wsa As Object
Dim wsb As Object
Dim wsc As Object


Set appWord = CreateObject("Word.Application")
Set doc = appWord.Documents.Add("T:\Vorlage.docx") '*** verwendet Datei nur als Vorlage ***
appWord.Visible = True

 Set wsa = ThisWorkbook.Worksheets("Tabelle1")
 Set wsb = ThisWorkbook.Worksheets("Tabelle2")
 Set wsc = ThisWorkbook.Worksheets("Tabelle3")
 
   With doc.Application.Selection
   
       If chk1 = True Then
            wsa.Range("A1:B5").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
        End If
        
       If chk2 = True Then
            wsb.Range("A1:C4").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
        End If
        
       If chk3 = True Then
            wsc.Range("A1:J31").Copy
            .PasteExcelTable False, False, False
            .TypeParagraph
            .TypeParagraph
       End If
End With


With CreateObject("Word.document")

      For Each it In .tables
        it.Rows.HeightRule = 2
        it.Rows.Height = .Application.CentimetersToPoints(0.5)
      Next

      .Application.Visible = True

End With

[snb]

Es wäre besser meine Code zu analysieren bis du diese ganz verstehst.

[Joe]

Gute Idee!

Kannst du mir bitte bei helfen?

Ich verstehe nicht ganz die Zeile "For Each it In .tables".

Ich weiß das "For Each" eine Schleife ist und so viel bedeutet wie für jede Tabelle (".tables") passiert ...,
aber dieses "it In. tables" versteh ich nicht und im Internet hab ich auch nichts zu gefunden.

Oder wie kann man aus Excel raus die ganzen Tabellen in Word makieren?
Dann könnt ich deine Befehle darauf beziehen.

Gruß Joe

[Kuwer]

Hallo Joe,

Du erklärst erst richtig die Funktionsweise der Schleife und fragst anschließend, wie du das machen kannst!?  :19:

Zusammengefasst so z.B.:

Private Sub cmdErstellen_Click()
 Dim appWord As Object
 Dim doc As Object
 Dim wsa As Object
 Dim wsb As Object
 Dim wsc As Object
 Dim it As Object
 
 Set wsa = ThisWorkbook.Worksheets("Tabelle1")
 Set wsb = ThisWorkbook.Worksheets("Tabelle2")
 Set wsc = ThisWorkbook.Worksheets("Tabelle3")
 
 Set appWord = CreateObject("Word.Application")
 Set doc = appWord.Documents.Add("T:\Vorlage.docx") '*** verwendet Datei nur als Vorlage *** 
 appWord.Visible = True

 With doc
   If chk1 = True Then
     wsa.Range("A1:B5").Copy
     .Paragraphs.last.Range.PasteExcelTable False, False, False
     .Content.InsertAfter String(2, vbCr)
   End If
   If chk2 = True Then
     wsb.Range("A1:C4").Copy
     .Paragraphs.last.Range.PasteExcelTable False, False, False
     .Content.InsertAfter String(2, vbCr)
   End If
   If chk3 = True Then
     wsc.Range("A1:J31").Copy
     .Paragraphs.last.Range.PasteExcelTable False, False, False
     .Content.InsertAfter String(2, vbCr)
   End If
   
   For Each it In .tables
     it.Rows.HeightRule = 2
     it.Rows.Height = .Application.CentimetersToPoints(0.5)
   Next
 End With
 
 Set doc = Nothing
 Set appWord = Nothing
End Sub

Gruß Uwe

[Joe]

Danke Uwe!!! Jetzt klappt es :)


Ja keine Ahnung hab ganze Zeit hin und her probiert, aber hat alles nicht funktioniert.


Schöne Grüße Joe

[Rabe]

Hi Joe,

Ich verstehe nicht ganz die Zeile "For Each it In .tables".

Ich weiß das "For Each" eine Schleife ist und so viel bedeutet wie für jede Tabelle (".tables") passiert ...,
aber dieses "it In. tables" versteh ich nicht und im Internet hab ich auch nichts zu gefunden.

"it" ist eine Variable für die Zeilen
"In" ist ein Bestandteil der For-Schleife wie das "Next" auch
.tables ist die Abkürzung für doc.tables, also wo die Schleife ablaufen soll: in dem Word-Dokument in allen Tabellen

PHP-Code:

For Each it In .tables
     it.Rows.HeightRule = 2
     it.Rows.Height = .Application.CentimetersToPoints(0.5)
   Next 


geht da auch noch die Spaltenbreite automatisch?

[snb]

Code:

Sub M_snb()
   With CreateObject("Word.document")
     For j = 1 To 3
        if Me("chk" & j) then
         ThisWorkbook.Sheets("Tabelle" & j).Cells(1).CurrentRegion.Copy
          .Paragraphs.last.Range.PasteExcelTable False, False, False
          .Content.InsertAfter String(2, vbCr)
        end if
     Next

     For Each it In .tables
        it.Rows.HeightRule = 2
        it.Rows.Height = .Application.CentimetersToPoints(0.5)
      Next

      .Application.Visible = True 
   End With
End Sub

Diese Code reicht.
Benützte F8 zum analysieren

[Joe]

Hey Uwe,

ja mittlerweile habe ich das halbwegs verstanden, ich war irritiert weil das "it" nicht als Variable deklariert ist.

Und zu deiner Frage, dann müsste man die Zeile "Row" in Spalte tauschen und die Höhe "Hight" als Breite.
War das eine Testfrage, um zu wissen ob ich verstanden habe?
Wenn ja dann hoffe ich das ich mich nicht blamiert habe :D


Hi snb,

den Ablauf deines Codes hab ich verstanden, nur die einzelnen Befehle verstand ich nicht ganz.


Danke euch beiden!

Gruß Joe