Microsoft Excel

Herbers Excel/VBA-Archiv

Excel in Word - Zeilen trennen

Betrifft: Excel in Word - Zeilen trennen von: studyy
Geschrieben am: 21.10.2014 14:13:39

Hallo zusammen,

ich hab mal wieder ein Problem und komme sowas von nicht voran.
es ist für mich super-kompliziert.

ich hab eine excel-tabelle mit überschriften in spalte A, unterüberschriften in spalte B und ein paar datensätze direkt unter den unterüberschriften in spalte B.
aus diesen daten erstelle ich diagramme, auswertungen etc. aber das ist nicht relevant für mein problem.
ich kopiere diese daten per makro in word als eine tabelle.
das alles klappt. jetzt möchte ich aber nicht die ganze tabelle zusammen einfügen.
sondern nach den überschriften trennen, also mehrere kleine tabellen untereinander.
dabei kann es sein, dass eine überschrift gar nicht auftaucht. in der datei könnt ihr sehen, wie das ganze aufgebaut ist.

https://www.herber.de/bbs/user/93267.xlsx

es kann z.b. sein, dass unter Ü1 nicht ü1.1 (und somit auch nicht die datensätze zu dieser überschrift) sondern direkt ü1.2 kommt mit seinen datensätzen. oder aber direkt ü1.4 usw. das selbe gilt auch für Überschrift2. ü2.1 kann ausfallen und es kann direkt ü2.1 kommen.
jetzt möchte ich einfach die überschriften (und zugehörige zeilen darunter) als eine tabelle in word einfügen. dann die nächste überschrift genauso. dann die nächste usw.
das ganze soll halt nicht in EINER tabelle in word stehen. perfekt wäre, wenn die überschriften in word über die jeweiligen tabellen geschrieben werden, also nicht als eine tabellenzeile. aber dies ist dann eher ein nice-to-have.

kann mir bei diesem makro jemand helfen.
würde mich sehr darüber freuen.

grüße studyy

  

Betrifft: AW: Excel in Word - Zeilen trennen von: fcs
Geschrieben am: 21.10.2014 15:51:33

Hallo studyy,

noch ein paar Verständnisfragen:
1. Sollen die Daten aus excel in eine neue leere Worddatei übertragen werden?
Oder hast du eine Datei/Vorlagedatei in die eingefügt werden soll?

2. Woran erkennt man in Spalte B die Überschriften bzw. wie unterscheiden sie sich eindeutig von den Datenzeilen?
Beginnen die Überschriftenzeilen immer mit ü und einer Ziffer?

3. Sollen immer jeweils nur die Zellen mit den Datensatzen in Spalte B kopiert werden oder sollen mehrere Spalten kopiert werden?

4. Wie soll der Datensatzbereich in Word eingefügt werden?
Als Grafik oder als Excel-Objekt?

Gruß
Franz


  

Betrifft: AW: Excel in Word - Zeilen trennen von: Studyy
Geschrieben am: 21.10.2014 16:42:56

Hallo Franz,

Also Zu 1.
Ich hab eine Vorlage, die ich öffne und in zeile 30 einfuge. das alles klappt eigentlich schon. Nur das getrennte einfugen.. :)

Zu 2.
Nein die Überschriften heissen ort, Adresse, nummer, name und ein paar andere bezeichnungen. Ich hab hier nur beispielsweise ü1, ü1.1 etc. Genommen. Damit wird auch der aufbauder datei deutlich. die uberschriften haben also kein ü und ziffern. Ich würde die ü's durch die richtigen Bezeichnungen ersetzen.

Zu 3.
Es sollen immer von einer Überschrift bis zur nächsten Überschrift die zeilen kopiert werden von spalte a bis h. Tut mir leid, hab das gar nicht erwähnt.

Zu 4.
Eingefugt werden sollte es nicht als grafik. Lediglich als tabellen.

Danke schonmal fur jegliche hilfe.

Grüße


  

Betrifft: AW: Excel in Word - Zeilen trennen von: fcs
Geschrieben am: 21.10.2014 17:28:45

Hallo Studyy,

nachfolgend ein Makro mit entsprechenden Einfüge-/Kopier-Aktionen.

Ich hoffe du kannst es in dein vorhandenes Makro integrieren.

Gruß
Franz

'Erstellt unter Excel 2010
Sub Daten_nach_Word()
  Dim wks As Worksheet
  Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long
  Dim wdPasteOption As Long
  Dim rngData As Range
  Dim strUeberschrift As String
  
  Dim wdApp As Object 'Word.Application
  Dim wdDoc As Object 'Word.Document
  
  Set wks = ActiveSheet
  
  'Word-Anwendung kreieren
  Set wdApp = VBA.CreateObject("Word.Application")
  wdApp.Visible = True
  
  'neues Dokument anlegen
  Set wdDoc = wdApp.Documents.Add(Template:="D:\Test\TestDoc.docx")
  
  'Einfügeposition selektieren
  wdDoc.Range(wdDoc.Characters.Count - 1, wdDoc.Characters.Count - 1).Select
  
  wdPasteOption = 1 'DataType für PasteSpecial-Aktion in Word _
                       9 = wdPasteEnhancedMetafile (Grafik) _
                       0 = wdPasteOLEObject (Excel-Tabellenobject) _
                       1 = wdPasteRTF  (Rich-Text-Format) _
                      10 = wdPasteHTML (HTML-Format)

  Zeile1 = 1: Zeile2 = 0 'Zeilenzähler für Datensätze zurücksetzen
  With wks
    'Zeilen in Exeltabelle abarbeiten
    For Zeile = 1 To .UsedRange.Row + .UsedRange.Rows.Count
      If .Cells(Zeile, 1).Text <> "" And .Cells(Zeile, 2).Text = "" Then
        'Hauptüberschrift
        strUeberschrift = .Cells(Zeile, 1).Text
        If Zeile2 > 0 Then
          Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
          rngData.Copy
          wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
            Placement:=0, DisplayAsIcon:=False 'Placement: 0 =wdInLine
          wdApp.Selection.TypeParagraph
        End If
        'Hauptüberschrfit einfügen
        wdApp.Selection.TypeParagraph
        wdApp.Selection.TypeText Text:=strUeberschrift
        wdApp.Selection.TypeParagraph
        
        Zeile1 = Zeile + 1: Zeile2 = 0 'Zeilenzähler für Datensätze neu setzen
      ElseIf .Cells(Zeile, 1).Text = "" And .Cells(Zeile, 2).Text = "" Then
        'Zeile nach letzten Daten
        If Zeile2 > 0 Then
          'Zellbereich mit Datensätzen setzen und kopieren
          Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
          rngData.Copy
          wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
            Placement:=0, DisplayAsIcon:=False ' Placement: 0 =wdInLine
          wdApp.Selection.TypeParagraph
        End If
      Else
        'Prüfen, ob Unterüberschrift oder Datensatz
        Select Case .Cells(Zeile, 2) 'Text in Spalte B
          Case "Adresse", "Ort", "Name", "Nummer"
            'Unterüberschrift
            strUeberschrift = .Cells(Zeile, 2).Text
            If Zeile2 > 0 Then
              'Zellbereich mit Datensätzen setzen und kopieren
              Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
              rngData.Copy
              wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
                Placement:=0, DisplayAsIcon:=False 'Placement: 0 =wdInLine
              wdApp.Selection.TypeParagraph
            End If
            'Unterüberschrfit einfügen
            wdApp.Selection.TypeText Text:=strUeberschrift
            wdApp.Selection.TypeParagraph
            Zeile1 = Zeile + 1: Zeile2 = 0 'Zeilenzähler für Datensätze neu setzen
          Case Else
            'Datensatzzeile
            Zeile2 = Zeile
        End Select
      End If
    Next
  End With
  wdApp.Activate
  Set wdApp = Nothing: Set wdDoc = Nothing: Set wks = Nothing: Set rngData = Nothing
  Application.CutCopyMode = False
End Sub



  

Betrifft: AW: Excel in Word - Zeilen trennen von: Studyy
Geschrieben am: 21.10.2014 20:18:52

Hallo Franz,

Super.
Danke. Werde ich testen. Ich melde mich dann danach.

Grüße studyy


  

Betrifft: AW: Excel in Word - Zeilen trennen von: Studyy
Geschrieben am: 25.10.2014 06:38:22

Hallo nochmal :)

Sorry dass ich mich zwei tage verspatet melde.
Dein code hat eigentlich funktioniert. Aber die breite der tabellen ist sehr klein.
Konnte ich schon einstellen dass er auf Fenster anpasst die tabellen?

Grüße und danke schonmal fur hilfe


  

Betrifft: AW: Excel in Word - Zeilen trennen von: fcs
Geschrieben am: 25.10.2014 13:15:57

Hallo Studdy,

wenn die aus den Spaltenbreiten in Excel abgeleiteten Spaltenbreiten nach dem Einfügen nicht optimal sind, dann müssen die Breiten von Tabellen und Spalten nach dem Einfügen individuell angepasst werden.

Gruß
Franz

'Erstellt unter Excel 2010
Sub Daten_nach_Word()
  Dim wks As Worksheet
  Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long
  Dim wdPasteOption As Long
  Dim rngData As Range
  Dim strUeberschrift As String
  
  Dim wdApp As Object 'Word.Application
  Dim wdDoc As Object 'Word.Document
  Dim intTabCount As Integer
  
  Set wks = ActiveSheet
  
  'Word-Anwendung kreieren
  Set wdApp = VBA.CreateObject("Word.Application")
  wdApp.Visible = True
  
  'neues Dokument anlegen
  Set wdDoc = wdApp.Documents.Add(Template:="C:\Users\Public\Test\TestDoc.docx")
  
  'Einfügeposition selektieren
  wdDoc.Range(wdDoc.Characters.Count - 1, wdDoc.Characters.Count - 1).Select
  
  wdPasteOption = 1 'DataType für PasteSpecial-Aktion in Word _
                       9 = wdPasteEnhancedMetafile (Grafik) _
                       0 = wdPasteOLEObject (Excel-Tabellenobject) _
                       1 = wdPasteRTF  (Rich-Text-Format) _
                      10 = wdPasteHTML (HTML-Format)

  Zeile1 = 1: Zeile2 = 0 'Zeilenzähler für Datensätze zurücksetzen
  intTabCount = wdDoc.Tables.Count
  With wks
    'Zeilen in Exeltabelle abarbeiten
    For Zeile = 1 To .UsedRange.Row + .UsedRange.Rows.Count
      If .Cells(Zeile, 1).Text <> "" And .Cells(Zeile, 2).Text = "" Then
        'Hauptüberschrift
        strUeberschrift = .Cells(Zeile, 1).Text
        If Zeile2 > 0 Then
          Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
          rngData.Copy
          wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
            Placement:=0, DisplayAsIcon:=False 'Placement: 0 =wdInLine
          wdApp.Selection.TypeParagraph
        End If
        'Hauptüberschrfit einfügen
        wdApp.Selection.TypeParagraph
        wdApp.Selection.TypeText Text:=strUeberschrift
        wdApp.Selection.TypeParagraph
        
        Zeile1 = Zeile + 1: Zeile2 = 0 'Zeilenzähler für Datensätze neu setzen
      ElseIf .Cells(Zeile, 1).Text = "" And .Cells(Zeile, 2).Text = "" Then
        'Zeile nach letzten Daten
        If Zeile2 > 0 Then
          'Zellbereich mit Datensätzen setzen und kopieren
          Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
          rngData.Copy
          wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
            Placement:=0, DisplayAsIcon:=False ' Placement: 0 =wdInLine
          wdApp.Selection.TypeParagraph
        End If
      Else
        'Prüfen, ob Unterüberschrift oder Datensatz
        Select Case .Cells(Zeile, 2) 'Text in Spalte B
          Case "Adresse", "Ort", "Name", "Nummer"
            'Unterüberschrift
            strUeberschrift = .Cells(Zeile, 2).Text
            If Zeile2 > 0 Then
              'Zellbereich mit Datensätzen setzen und kopieren
              Set rngData = .Range(.Cells(Zeile1, 1), .Cells(Zeile2, 8))
              rngData.Copy
              wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteOption, _
                Placement:=0, DisplayAsIcon:=False 'Placement: 0 =wdInLine
              wdApp.Selection.TypeParagraph
            End If
            'Unterüberschrfit einfügen
            wdApp.Selection.TypeText Text:=strUeberschrift
            wdApp.Selection.TypeParagraph
            Zeile1 = Zeile + 1: Zeile2 = 0 'Zeilenzähler für Datensätze neu setzen
          Case Else
            'Datensatzzeile
            Zeile2 = Zeile
        End Select
      End If
      'Prüfen ob sich die Tabellenanzahl geändert hat
      If intTabCount <> wdDoc.Tables.Count Then
        intTabCount = wdDoc.Tables.Count
        'Tabellenbreite und Spaltenbreiten der Tabelle einstellen
        With wdDoc.Tables(intTabCount)
            .AllowAutoFit = False
            .PreferredWidthType = 3 '3 = wdPreferredWidthPoints
            .PreferredWidth = Application.CentimetersToPoints(17)
            .Columns.PreferredWidthType = 3 '3 = wdPreferredWidthPoints
            .Columns(1).Width = Application.CentimetersToPoints(0.5)
            .Columns(2).Width = Application.CentimetersToPoints(3.5)
            .Columns(3).Width = Application.CentimetersToPoints(2)
            .Columns(4).Width = Application.CentimetersToPoints(3)
            .Columns(5).Width = Application.CentimetersToPoints(1.5)
            .Columns(6).Width = Application.CentimetersToPoints(2.5)
            .Columns(7).Width = Application.CentimetersToPoints(2)
            .Columns(8).Width = Application.CentimetersToPoints(2)
        End With
      End If
    Next
  End With
  wdApp.Activate
  Set wdApp = Nothing: Set wdDoc = Nothing: Set wks = Nothing: Set rngData = Nothing
  Application.CutCopyMode = False
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Excel in Word - Zeilen trennen"