Moin!
Warum nicht einfach das Beste aus zwei Welten:
Excel-Tabelle in Word-Dokument.
Dann dürfen auch Romane in die Fußzeile.
Und ergänzend:
Die Fußzeile ändert sich doch nicht, warum willst Du sie überhaupt per VBA eintragen?
Gruß Ralf
Hallo,
Danke für eure Antworten, habe jetzt per VBA in die linke Fußzeile den Text eingetragen ( ginge natürlich auch über Seite einrichten) und dann den 2. rechten Teil als Grafik eingefügt.
Funktioniert soweit alles.
Hallo,
habe da doch noch eine Frage:
in der Excel kommt es vor das die Begriffe komplett klein aber auch Groß geschrieben werden und deshalb kommt es zu Fehlern
wie kann ich die Groß Kleinschreibung für die Auswertung abschalten?
Select Case lstResponse.List(zeLB, 4)
Case "KG", "BAD", "LYM30", "LYM45", "LYM60", "MASSAGE", "FUSSPFLEGE", "PODOLOGIE", "FUSSREFLEX", "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
Hallo,
brauche doch nochmal eure Hilfe.
Meine Suchergebnisse werden in einer Listbox(lstResponse) aufgelistet, dort kann ich per Mausklick auf einen Eintrag zu der Position springen.
Aus der gleichen Liste möchte ich selektieren was ich ausdrucken möchte.
Listeninhalt drucken:
Private Sub cmdPrint_Click()
Dim zeLB As Long, spLB As Long
Dim zeTB As Long, spTB As Long
Dim spab As Long, spac As Long
Dim agTB As Long, agLB As Long
Dim allesDrucken As Boolean
' Zellen leeren
Range("Druckvorlage!A5:P1000") = "" 'Bereich in den die Ergebnis eingetragen werden
'--- Drucker auswählen
Application.Dialogs(xlDialogPrinterSetup).Show
With ActiveSheet.PageSetup
.LeftFooter = "&""Calibri""&10&BBitte beachten Sie:&B" & Chr(10) & "&8Terminabsage nur in dringenden" & Chr(10) & "Fällen, spätestens jedoch " & Chr(10) & "24 Stunden 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) & "Um Behandlungspausen zu vermeiden" '& Chr(10) & "sowie Termin- und Therapeutenwünsche" & Chr(10) & "zu berücksichtigen, bitte Folgetermine" & Chr(10) & "8 Wochen im Voraus vereinbaren!" & Chr(10) & "&BMittagpause 12 - 14 Uhr&B"
End With
'-- Prüfen, ob alles gedruckt werden muss
For zeLB = 0 To lstResponse.ListCount - 1
allesDrucken = allesDrucken Or lstResponse.Selected(zeLB)
Next
zeTB = 4
spLB = 7
'--- 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 UCase(lstResponse.List(zeLB, 4))
Case "KG", "BAD", "LYM30", "LYM45", "LYM60", "MASSAGE", "FUSSPFLEGE", "PODOLOGIE", "FUSSREFLEX", "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 = 2 To lstResponse.ColumnCount - 1 'Ab welcher Spalte aus der Suchergebnisliste soll gedruckt werden
Sheets("Druckvorlage").Cells(zeTB, spLB + 1) = lstResponse.List(zeLB, spLB) 'zeTB Zeile, spTB Spalte
Next
For spab = 1 To 1
spac = 1
agTB = 1 'Zeile 2
agLB = 6 'Spalte 5 (E)
Sheets("Druckvorlage").Cells(agTB, agLB) = lstResponse.List(spab, spac)
Next
End If
Next
Sheets("Druckvorlage").Visible = True
' Drucke Tabellenblatt
Worksheets("Druckvorlage").PrintOut
Sheets("Druckvorlage").Visible = True
End Sub
Mein Problem:
Stell ich in den Eigenschaften der Listbox Multiselect auf 0 fmMultiselectMulti dann geht drucken aber wenn ich per Doppelklickereignis zum Ergebnis springen will kommt der Laufzeitfehler 1004 an dieser Stelle:
Doppelklick Ereignis zum Ergebnis:
Private Sub lstResponse_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s As String
If lstResponse.ListIndex > -1 Then
s = Me.lstResponse.Column(6, Me.lstResponse.ListIndex) & "." & Sheets("Januar").Range("A1")
Sheets(Format(s, "MMMM")).Select
If lstResponse.Tag <> "" Then
Range(lstResponse.Tag).Interior.ColorIndex = 0
Cells(8, Range(lstResponse.Tag).Column).Interior.ColorIndex = 0
Cells(Range(lstResponse.Tag).Row, 1).Interior.ColorIndex = 43
Cells(Range(lstResponse.Tag).Row, 2).Interior.ColorIndex = 19
End If
Range(lstResponse.Value).Select
ActiveCell.Interior.ColorIndex = 4
Cells(8, ActiveCell.Column).Interior.ColorIndex = 4
Cells(ActiveCell.Row, 1).Interior.ColorIndex = 4
Cells(ActiveCell.Row, 2).Interior.ColorIndex = 4
lstResponse.Tag = ActiveCell.Address
Cancel = True
End If
'Form schließen:
Unload Me
End Sub
Hallo,
kann den Niemand helfen ? komme nicht weiter
Hallo,
was steht denn in lstResponse.Tag?
Hallo,
Sorry da hat sich ein Fehler eingeschlichen. Bin wohl etwas durch den Wind gewesen, Sorry.
Bei fmMultSelectiSingle funktioniert der Sprung mit Doppelklick.
Mein Problem:
Stell ich in den Eigenschaften der Listbox Multiselect auf 1 fmMultiselectMulti oder auf 2 fmMultiSelectExtended dann geht drucken aber wenn ich per Doppelklickereignis zum Ergebnis springen will kommt der Laufzeitfehler 1004 an dieser Stelle:
Korrektur:
Doppelklick Ereignis zum Ergebnis:
Private Sub lstResponse_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s As String
If lstResponse.ListIndex > -1 Then
s = Me.lstResponse.Column(6, Me.lstResponse.ListIndex) & "." & Sheets("Januar").Range("A1")
Sheets(Format(s, "MMMM")).Select
If lstResponse.Tag <> "" Then
Range(lstResponse.Tag).Interior.ColorIndex = 0 nicht diese Zeile
Cells(8, Range(lstResponse.Tag).Column).Interior.ColorIndex = 0
Cells(Range(lstResponse.Tag).Row, 1).Interior.ColorIndex = 43
Cells(Range(lstResponse.Tag).Row, 2).Interior.ColorIndex = 19
End If
Range(lstResponse.Value).Select sondern diese, und da steht = Null drin,
Statt der Zellenbezeichnung
ActiveCell.Interior.ColorIndex = 4
Cells(8, ActiveCell.Column).Interior.ColorIndex = 4
Cells(ActiveCell.Row, 1).Interior.ColorIndex = 4
Cells(ActiveCell.Row, 2).Interior.ColorIndex = 4
lstResponse.Tag = ActiveCell.Address
Cancel = True
End If
'Form schließen:
Unload Me
End Sub
Jetzt ist es richtig dargestellt, Sorry nochmal an dieser Stelle.
Gruß Arnold
Hallo,
schade innerhalb 10 Tagen keine Antwort , hatte mir mehr Hilfe erwartet.
Muss wohl ganz schön verschi…….. haben mit der Art wie ich die Probleme Poste.
Gruß und Danke an diejenigen die mir bis hierher geholfen hatten.
Hallo,
(15.11.2018, 16:43)Arni49 schrieb: [ -> ]schade innerhalb 10 Tagen keine Antwort , hatte mir mehr Hilfe erwartet.
wie stellst Du Dir das denn vor, wie wir ohne einer Beispieldatei von Dir helfen sollen?
Gruß Uwe