Registriert seit: 16.12.2016
Version(en): 2013
Code: 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
For spLB = 1 To lstResponse.ColumnCount - 1
Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, spLB)
Next
End If
Next
Sheets("Druckvorlage").Visible = True
' Drucke Tabellenblatt
Worksheets("Druckvorlage").PrintOut
Sheets("Druckvorlage").Visible = True
End Sub
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 ?
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
25.10.2018, 01:08
(Dieser Beitrag wurde zuletzt bearbeitet: 25.10.2018, 01:08 von Kuwer.)
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
Registriert seit: 16.12.2016
Version(en): 2013
Hallo Uwe,
leider funktioniert es so nicht! Der Ausdruck hat noch die gleiche Zeit.
Gruß Arnold
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 16.12.2016
Version(en): 2013
Hallo,
habe folgende Änderung gemacht:
zeLB, 3 auf 4 geändert.
Code: 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, 4)
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, 2)) + TimeSerial(0, 20, 0), "hh:nn")
Case "PM40", "PVM40", "CMDP40", "PKG40"
Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = Format(CDate(lstResponse.List(zeLB, 2)) - TimeSerial(0, 20, 0), "hh:nn")
Case Else
Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, 2)
End Select
For spLB = 1 To lstResponse.ColumnCount - 1
Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, spLB) 'zeTB Zeile, spTB Spalte
[attachment=20441]
In der Liste zum Drucken fängt er aber erst in der 2. Zeile an die Zeiten zu ändern.
Registriert seit: 16.12.2016
Version(en): 2013
Hallo,
kann den niemand helfen?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
28.10.2018, 06:39
(Dieser Beitrag wurde zuletzt bearbeitet: 28.10.2018, 06:39 von schauan.)
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.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 16.12.2016
Version(en): 2013
28.10.2018, 21:09
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 ?
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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 
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 02.12.2017
Version(en): Office 365
Du könntest statt Zellen zu füllen, einfach eine Textbox einfügen..
Eine Menge reden, aber nichts sagen können viele...
|
