Zeilenumbrüche Excel nach **

Anonym_26466ffe2232 · 11. November 2019 um 12:45

Hallo Leute,

ich habe folgendes Problem. Ich habe eine Excel Tabelle aus einem SAP-Export. Etwas abgewandelt sieht diese so aus:

Mein Ziel ist es jetzt diese Tabelle zu drucken. Und dabei immer nach den ********* einen Seitenumbruch einfügen. Auf der neuen Seite soll der Tabellenkopf nochmal angezeigt werden.

Einen Lösungsansatz habe ich auch schon:

’ neues Tabellenblatt anlegen, benennen, nach hinten verschieben
Sheets.Add.Name = „Tabelle2“
Sheets(„Tabelle2“).Move After:=Sheets(2)
’ Inhalt vom ersten Tabellenblatt kopieren
Sheets(„Tabelle1“).Select
Cells.Select
Selection.Copy
’ Ins Zweite einfügen
Sheets(„Tabelle2“).Select
ActiveSheet.Paste
’ Spalten ausblenden
Columns(„A:A“).Select
Selection.EntireColumn.Hidden = True
’ Tabellenkopf formatieren
Range(„A1:“).Select
Selection.Font.ColorIndex = 1
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
’ Letzte Zeile mit Inhalt finden
Dim lngLastRow As Long
With ActiveSheet
lngLastRow = .Cells.Find(What:="*", After:=Range(„A1“), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
’ .PageSetup.PrintArea = „$A$1:blush:V$“ & lngLastRow
End With
’ Spalten mit Inhalt auswählen
Range("$A$1:blush:V$" & lngLastRow).Select
’ Tabellenrand einfügen
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sub
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
’ Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = " $A$1:blush:V$" & lngLastRow
With ActiveSheet.PageSetup
.LeftHeader = „“
.CenterHeader = „“
.RightHeader = „“
.LeftFooter = „“
.CenterFooter = „“
.RightFooter = „“
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
’ Zeilen mit ** suchen
’ Seitenumbrüche vor Zeilen mit Sternchen einfügen
End Sub

Vielen Dank im Voraus!!

Anonym_26466ffe2232 · 11. November 2019 um 12:45

Ähm, falls das nicht so verständlich war. Der obere Teil funktioniert.
Die Probleme habe ich hier unten:
’ Zeilen mit ** suchen
’ Seitenumbrüche vor Zeilen mit Sternchen einfügen

Dafür bräuchte ich einen Ansatz für den Code.
Bin für jede Frage sehr dankbar!!

Reinhard_fb8cb7 · 11. November 2019 um 12:47

Hallo GF,

ich habe folgendes Problem. Ich habe eine Excel Tabelle aus
einem SAP-Export. Etwas abgewandelt sieht diese so aus:

http://yfrog.com/1xexceloj

lade mal eine Mappe hoch mit Daten via rapidshare o.ä. ( FAQ:2606 ).
In Tab1 sieht man die Tabelle nach dem Import.
In Tab2 wie Tab1 nach deinem Makro aussehen soll. manuell bindest du da Seitenumbrüche ein.

Am besten Originaldaten. kannste sie ja anonymisieren, Hauptsache eine Zelle mit Text bleibt eine Zelle mit Text usw., also die Struktur gewahrt.

Dein Makro hat enormes Kürzungspotential. Ist aber vöölig normal, wir haben alle mal mit Select angefangen.

Und gib bitte deine Excelversion an. Ich hab zwar eine Vermutung aufgrund einiger Parameter/Eigenschaften aber warum soll ich raten.

Gruß
Reinhard

Anonym_26466ffe2232 · 11. November 2019 um 12:47

Hallo Reinhard,

ich habe die Datei jetzt mal hochgeladen:
http://rapidshare.com/files/397765759/Testdaten.xls…

Als Version läuft das gute alte Excel 2002 (10.6860.6858) SP3.

Tabelle 1 ist die unveränderte Tabelle.
Tabelle 2 nach dem bisherigen Makro. So soll sie auch aussehen. Druckbereich und sowas ist inzwischen okay.

Es fehlt lediglich noch der Seitenumbruch bei Zeilen mit 2 oder mehr *.

Vielen Dank für deine Hilfe.

PS: Um das Makro auszuführen, müsstest du die Tabelle2 löschen. Beim Ausführen wird sie ja wieder genauso erstellt.

RakonDark_2d341e · 11. November 2019 um 12:47

PS: Um das Makro auszuführen, müsstest du die Tabelle2
löschen. Beim Ausführen wird sie ja wieder genauso erstellt.

und dann gleich "wenn vorhanden nachfragen ob löschen, wenn ja dann weg damit, wenn nein dann wars wohl ein fehlaufruf

-)

wenn wir schon beim automatisieren sind

Anonym_26466ffe2232 · 11. November 2019 um 12:47

Hallo,

noch ein kleiner Nachtrag. In den Zeilen mit **, also 4, 10, 15 und 20 würde Bezeichnung und Preis nichts stehen!

Vielleicht kann man es ja darüber lösen, wenn man nicht nach * suchen kann, weil * ja sicher auch als Platzhalter verwendet werden kann.

Markus_K_ln · 11. November 2019 um 12:48

Hi,

die Anweisungen für die Suche nach zwei Sternchen und das Einfügen des Seitenwechsels lauten:

Dim i As Long
Dim sText As String
sText = Chr(42) & Chr(42)
 ActiveSheet.Range("B1").Activate
For i = 1 To 15 'hierher kommt die letzte Zelle
 With ActiveCell
 .Offset(1, 0).Activate
 If Left(.Text, 2) = sText Then
 .Select
 .Font.Bold = True
 End If
 End With 'ActiveCell

 ActiveSheet.HPageBreaks.Add Before:=ActiveCell
Next i

Nach Sternchen suchen geht nur, indem man die Zellen der Reihe nach durchläuft. Sternchen bei Cells.Find, egal wieviele, finden alles.
Beim Testen des Seitenumbruchs allerdings: Mein Excel zeigt in der Normalansicht an, daß einer eingefügt wurde, bricht an der Stelle aber die Seite nicht um. Ich hab’ trotzdem mal gepostet.

HTH

M.

Reinhard_fb8cb7 · 11. November 2019 um 12:48

http://rapidshare.com/files/397765759/Testdaten.xls…
Tabelle 1 ist die unveränderte Tabelle.
Tabelle 2 nach dem bisherigen Makro. So soll sie auch

Hallo GF,

teste mal dieses:

Option Explicit
'
Sub Erstellen()
Dim Zei As Long, wks1 As Worksheet, Z As Long
' Tastenkombination: Strg+q
Set wks1 = Worksheets("Tabelle1")
Zei = wks1.Cells(Rows.Count, 1).End(xlUp).Row
' neues Tabellenblatt anlegen, benennen, nach hinten verschieben
Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet
 ' Inhalt vom ersten Tabellenblatt kopieren
 ' Ins Zweite einfügen
 wks1.Range("B1:smiley:" & Zei).Copy Destination:=.Range("A1")
 ' Tabellenkopf formatieren
 With .Range("A1:C1")
 .Font.ColorIndex = 1
 .Interior.ColorIndex = 15
 .Interior.Pattern = xlSolid
 End With
 For Z = Zei To 2 Step -1
 If Left(.Cells(Z, 1).Value, 1) = "\*" Then
 .Rows(Z).Delete
 .HPageBreaks.Add .Cells(Z, 1)
 Zei = Zei - 1
 End If
 Next Z
 ' Tabellenrand einfügen
 For Z = 7 To 12
 With .Range("A1:C" & Zei).Borders(Z)
 .LineStyle = xlContinuous
 .Weight = xlThin
 .ColorIndex = xlAutomatic
 End With
 Next Z
 .PageSetup.PrintTitleRows = "$1:blush:1"
 .PrintPreview
End With
End Sub

Gruß
Reinhard

Anonym_26466ffe2232 · 11. November 2019 um 13:00

Hallo Reinhard,

tausend Dank für deine Hilfe!!!

Ich konnte deinen Code wunderbar für meine Zwecke adaptieren!

Vielen, vielen Dank!