Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Listeneintrag Uhrzeit zum drucken verändern
#11
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
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten Top
#12
Thumbs Up 
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.
Antworten Top
#13
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
Antworten Top
#14
Smile 
habe es selber gelöst
Antworten Top
#15
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
Antworten Top
#16
Sad 
Hallo,

kann den Niemand helfen ? komme nicht weiter
Antworten Top
#17
Hallo,

was steht denn in lstResponse.Tag?
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#18
Sad 
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
Antworten Top
#19
Sad 
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.
Antworten Top
#20
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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste