Clever-Excel-Forum

Hallo,
das drucken der Listeneinträge funktioniert.
Jetzt müsste ich noch vor dem Druck die  Uhrzeiten anhand der Behandlungsarten zum drucken wie folgt verändern.
Behandlungsarten:
KG, Bad, LYM30, LYM45, LYM60, Massage, Fußpflege, Podologie, Fußreflex, CMD, VM, BM = 20 Minuten später als eingetragen
PM40, PVM40, CMDP40, PKG40 = 20 Minuten früher als eingetragen
Hat jemand eine Idee wie das umgesetzt werden kann ?

Hallo,

so vielleicht:

Private Sub cmdPrint_Click()

Dim zeLB As Long, spLB As Long

Dim zeTB As Long, spTB As Long

Dim allesDrucken As Boolean



   ' Zellen leeren

   Range("Druckvorlage!A2:P1000") = ""

    

   Application.PrintCommunication = False

   With ActiveSheet.PageSetup

       .PrintTitleRows = "$1:$1"

       .PrintTitleColumns = ""

   End With

   Application.PrintCommunication = True

   ActiveSheet.PageSetup.PrintArea = ""

   Application.PrintCommunication = False

   With ActiveSheet.PageSetup

       .PrintTitleRows = "$1:$1"

       .PrintTitleColumns = ""

       .LeftHeader = ""

       .CenterHeader = "&P&""Fett""&36Behandlungs-Terminplan"

       .RightHeader = "" & Chr(10) & ""

       .LeftFooter = ""

       .CenterFooter = ""

       .RightFooter = ""

       .LeftMargin = Application.InchesToPoints(0.236220472440945)

       .RightMargin = Application.InchesToPoints(0.236220472440945)

       .TopMargin = Application.InchesToPoints(0.748031496062992)

       .BottomMargin = Application.InchesToPoints(0.354330708661417)

       .HeaderMargin = Application.InchesToPoints(0.31496062992126)

       .FooterMargin = Application.InchesToPoints(0.31496062992126)

       .PrintHeadings = False

       .PrintGridlines = False

       .PrintComments = xlPrintSheetEnd

       .PrintQuality = 600

       .CenterHorizontally = False

       .CenterVertically = False

       .Orientation = xlPortrait

       .Draft = False

       .PaperSize = 70

       .FirstPageNumber = xlAutomatic

       .Order = xlDownThenOver

       .BlackAndWhite = False

       .Zoom = False

       .FitToPagesWide = 1

       .FitToPagesTall = False

       .PrintErrors = xlPrintErrorsDisplayed

       .OddAndEvenPagesHeaderFooter = False

       .DifferentFirstPageHeaderFooter = False

       .ScaleWithDocHeaderFooter = True

       .AlignMarginsHeaderFooter = True

       .EvenPage.LeftHeader.Text = ""

       .EvenPage.CenterHeader.Text = ""

       .EvenPage.RightHeader.Text = ""

       .EvenPage.LeftFooter.Text = ""

       .EvenPage.CenterFooter.Text = ""

       .EvenPage.RightFooter.Text = ""

       .FirstPage.LeftHeader.Text = ""

       .FirstPage.CenterHeader.Text = ""

       .FirstPage.RightHeader.Text = ""

       .FirstPage.LeftFooter.Text = ""

       .FirstPage.CenterFooter.Text = ""

       .FirstPage.RightFooter.Text = ""

       End With

      

   '--- Drucker auswählen

   Application.Dialogs(xlDialogPrinterSetup).Show

   

   '-- Prüfen, ob alles gedruckt werden muss

   For zeLB = 0 To lstResponse.ListCount - 1

       allesDrucken = allesDrucken Or lstResponse.Selected(zeLB)

   Next

   

   zeTB = 1

   '--- selektierte Listboxeinträge in Zellen schreiben

   For zeLB = 0 To lstResponse.ListCount - 1

       If lstResponse.Selected(zeLB) Or Not allesDrucken Then

           zeTB = zeTB + 1

           Select Case lstResponse.List(zeLB, 3)

               Case "KG", "Bad", "LYM30", "LYM45", "LYM60", "Massage", "Fußpflege", "Podologie", "Fußreflex", "CMD", "VM", "BM"

                   Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = Format(CDate(lstResponse.List(zeLB, 1)) + TimeSerial(0, 20, 0), "hh:nn")

               Case "PM40", "PVM40", "CMDP40", "PKG40"

                   Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = Format(CDate(lstResponse.List(zeLB, 1)) - TimeSerial(0, 20, 0), "hh:nn")

               Case Else

                   Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, 1)

           End Select

           For spLB = 2 To lstResponse.ColumnCount - 1

               Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, spLB)

           Next

       End If

   Next

       

   ' Drucke Tabellenblatt

   Sheets("Druckvorlage").Visible = True

   Worksheets("Druckvorlage").PrintOut

   Sheets("Druckvorlage").Visible = False

End Sub

Gruß Uwe

Hallo Uwe,

leider funktioniert es so nicht! Der Ausdruck hat noch die gleiche Zeit.
Gruß Arnold

Hallo Arnold,

(26.10.2018, 05:22)Arni49 schrieb: [ -> ]leider funktioniert es so nicht! Der Ausdruck hat noch die gleiche Zeit.

und nun!? Bilderrätsel finde ich hier nicht so prickelnd.

Gruß Uwe

Hallo,

habe folgende Änderung gemacht:
zeLB, 3 auf 4 geändert.

[attachment=20441]
In der Liste zum Drucken fängt er aber erst in der 2. Zeile an die Zeiten zu ändern.

Hallo,

kann den niemand helfen?

Hallöchen,

wenn Du Dir die verschiedenen Codes anschaust - auch Deinen zuerst geposteten, solltest Du feststellen können, wieso erst Zeile 2 geändert wird.

Du setzt vor der Schleife die Variable für die Zeile auf 1 und erhöhst sie um 1 vor der ersten Änderung in der Schleife.

Hallo,
Habe es mir nochmal angesehen, jetzt klappt es.

Jetzt möchte ich noch via VBA unten in der Fußzeile folgende Texte platzieren:

Rechts:

[b]Bitte beachten Sie:[/b]

Terminabsage nur in dringenden

Fällen, spätestens jedoch 24 Stunden

vor der Behandlung.

Nicht rechtzeitig abgesagte Termine

werden privat in Rechnung gestellt.

Links auf gleicher Zeilenhöhe:

Hinweis für Dauerpatienten:
Um Behandlungspausen zu vermeiden
sowie Termin- und Therapeutenwünsche
zu berücksichtigen, bitte Folgetermine
8 Wochen im Voraus vereinbaren!
Mittagpause 12 – 14 Uhr

Habe es mit .Leftfooter und Rightfooter probiert, das Funktioniert aber wegen der vielen Zeichen nicht.

.LeftFooter = "&""Calibri""&8&BBitte beachten Sie:&B" & Chr(10) & "Terminabsage nur in dringenden" & Chr(10) & "Fällen, spätestens jedoch 24 Stunden" & Chr(10) & "vor der Behandlung." & Chr(10) & "Nicht rechtzeitig abgesagte Termine" & Chr(10) & "werden privat in Rechnung gestellt."

.RightFooter = "&""Calibri""&8&BHinweis für Dauerpatienten:&B" & Chr(10) & " ……. mehr geht nicht.


Gibt es noch eine andere Möglichkeit die Texte Unten als Fußzeile auf jeden Ausdruck zu bekommen ?

Hallöchen,

ich glaube, Du musst entweder die Texte radikal und auf das Wesentliche einkürzen, z.B.

Terminabsagen spätestens 24 Stunden
vor der Behandlung.
Nicht rechtzeitig abgesagte Termine
werden privat in Rechnung gestellt.

Hinweis für Dauerpatienten:
bitte Folgetermine 8 Wochen im
Voraus vereinbaren!
Mittagpause 12 – 14 Uhr

--> ohne Fett Formatierung

oder normale Tabellenzeilen benutzen Die Zeilen könntest Du beim Ausdruck mit VBA einfügen, ich nehme an, Du hast auch mal mehrere Blätter zu drucken. Eventuell reicht aber auch die Angabe auf dem ersten Blatt eines Ausdrucks, dann kannst Du das fest machen.


Eventuell schreibst Du die Mittagspause in die Mitte - die gilt doch nicht nur für Dauerpatienten

Du könntest statt Zellen zu füllen, einfach eine Textbox einfügen..