Drucken nach Zellenabfrage

Dieses Thema Drucken nach Zellenabfrage im Forum "Microsoft Office Suite" wurde erstellt von joergi78, 25. März 2008.

Thema: Drucken nach Zellenabfrage Hallo, kann ich es in Excel 2003 realisieren, dass man erst Drucken kann, wenn in Zelle I5 eine Zahl eingetragen...

  1. Hallo, kann ich es in Excel 2003 realisieren, dass man erst Drucken kann, wenn in Zelle I5 eine Zahl eingetragen wurde? Ansosten soll eine Fehlermeldung erscheinen.
    mfg
    Joergi78
     
  2. Hallo joergi78,

    packe folgendes Makro in die Code-Seite der Arbeitsmappe ('DieseArbeitsmappe') und passe die Blattnamen im Makro an.

    Grußmatjes :)
    Code:
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
     If Not TesteVorDruckenZelleAufZahl(ActiveSheet) Then Cancel = True
    End Sub
    '===========================================================================
    Private Function TesteVorDruckenZelleAufZahl(ws As Worksheet) As Boolean
    '*** gibt für nicht zu überwachende Blätter true zurück
     
     Dim bBlattUeberwacht As Boolean
     Dim x As Long
     
     TesteVorDruckenZelleAufZahl = True
     
     Dim TabellenBlattNamen As Variant
     TabellenBlattNamen = Array(Tabelle1, Tabelle2, Tabelle3)-><-- hier Blattnamen anpassen
     Const c_ueberwachterZellRange = I5
     
    ->Ist das Blatt überwacht ?
     For x = LBound(TabellenBlattNamen) To UBound(TabellenBlattNamen)
      If ws.Name = TabellenBlattNamen(x) Then bBlattUeberwacht = True: Exit For
     Next
     If Not bBlattUeberwacht Then Exit Function
    
    ->ist in der überwachten Zelle keine Zahl ?
     If Not ((ws.Range(c_ueberwachterZellRange).Value <> ) And _
       (IsNumeric(ws.Range(c_ueberwachterZellRange).Value))) Then
      TesteVorDruckenZelleAufZahl = False
      MsgBox  & c_ueberwachterZellRange &  auf Blatt  & ws.Name &  enthält keine Zahl.
     End If
       
    End Function
     
  3. Danke für deinen Tipp, aber ich habe das ganze so realisiert:
    Der erste Teil ist fürs Datum und der zweite Teil für die Zahl.
    1. Private Sub Workbook_BeforePrint(Cancel As Boolean)
    With Sheets(1).Range(M1)
    Do While Not IsDate(.Value)
    .Value = InputBox(Bitte Datum eingeben:)
    Loop
    End With

    2. If ActiveSheet.Range(I5) = Then
    wert = InputBox(Mietvertrag Nt. eintragen! ! !)
    Range(I5) = wert
    Cancel = True
    End If
    End Sub

    Mein Problem ist es, dass ich das Datum genau eingeben muss und nicht automatisch die Zellenformatierung übernommen wird.
    Meine Frage ist, geht das? Dass ich z.B. 28.3 eingebe und er mir 28. März 2008 ausgibt.

    Das wäre supi.
    gruß Joergi78
     
  4. Hallo joergi78,

    löst das dein Problem ?

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Sub Workbook_BeforePrint(Cancel As Boolean)
     
     Const cRANGE_DATUM = M1
     Const cFORMAT_DATUM = d. mmmm yyyy
     Const cRANGE_MIETVERTRAGNT = I5
     
     Dim s As String
     Dim Zelle As Range
     
     Set Zelle = ActiveSheet.Range(cRANGE_DATUM)
     If Not DatumPruefen(Zelle, cFORMAT_DATUM) Then
      Cancel = True
      GoTo AUFRAEUMEN
     End If
     
     
     Zelle = ActiveSheet.Range(cRANGE_MIETVERTRAGNT)
     If Zelle.Value =  Then
      s = InputBox(Mietvertrag Nt. eintragen! ! !)
      If s =  Then Cancel = True: GoTo AUFRAEUMEN
      Zelle = s
     End If
    AUFRAEUMEN:
     Set Zelle = Nothing
    End Sub
    
    Private Function DatumPruefen(Zelle As Range, sFormat As String) As Boolean
     
     Dim s As String, sZusatz As String, sEingabe As String
     Dim sTag As String, sMonat As String, sJahr As String
     Dim lTag As Long, lMonat As Long, lJahr As Long, pos As Long
     Dim ddate As Date
     
     If IsDate(Zelle.Value) Then
      DatumPruefen = True
      Exit Function
     End If
     
     Do
    NOCHMAL:
      s = InputBox( _
       Bitte Datum eingeben: & vbLf & (t.m oder t.m.yy oder t.m.yyyy) & _
       vbLf & vbLf & sZusatz, _
       Eingabe Datum, _
       s)
      
      If s =  Then Exit Function->Abbruch
      
      sEingabe = s: sTag = : sMonat = : sJahr = 
      
     ->*** Tag ***
      pos = InStr(1, sEingabe, .)
      If pos < 1 Then sZusatz = Angabe Tag ungültig.: GoTo NOCHMAL
      sTag = Left(sEingabe, pos - 1)
      sEingabe = Right(sEingabe, Len(sEingabe) - pos)->Tag aus Eingabe abschneiden
      On Error Resume Next
      lTag = sTag
      If Err.Number <> 0 Then
       Err.Clear: On Error GoTo 0
       sZusatz = Angabe Tag ungültig.: GoTo NOCHMAL
      End If
      On Error GoTo 0
      
     ->*** Monat ***
      pos = InStr(1, sEingabe, .)
      If pos < 1 Then
       sMonat = sEingabe
       sEingabe = 
      Else
        sMonat = Left(sEingabe, pos - 1)
       sEingabe = Right(sEingabe, Len(sEingabe) - pos)
      End If
      On Error Resume Next
      lMonat = sMonat
      If Err.Number <> 0 Then
       Err.Clear: On Error GoTo 0
       sZusatz = Angabe Monat ungültig.: GoTo NOCHMAL
      End If
      On Error GoTo 0
     
     ->*** Jahr ***
      sJahr = sEingabe
      If Len(sJahr) = 0 Then sJahr = Format(Now(), yyyy)
      On Error Resume Next
      lJahr = sJahr
      If Err.Number <> 0 Then
       Err.Clear: On Error GoTo 0
       sZusatz = Angabe Jahr ungültig.: GoTo NOCHMAL
      End If
      On Error GoTo 0
      If lJahr < 100 Then lJahr = lJahr + 2000
      
     ->*** Wertebereiche prüfen
      On Error Resume Next
      ddate = lTag & . & lMonat & . & lJahr
      If Err.Number <> 0 Then
       Err.Clear: On Error GoTo 0
       sZusatz = Datum ungültig.: GoTo NOCHMAL
      End If
      On Error GoTo 0
      If (Day(ddate) <> lTag) Or _
        (Month(ddate) <> lMonat) Or _
        (lJahr > 2039) Then
       sZusatz = Datum ungültig.: GoTo NOCHMAL
      End If
      
     ->*** Zelle formatieren und Datum eintragen
      Zelle.NumberFormat = sFormat
      Zelle.Value = ddate
      Exit Do
      
     Loop
     
     DatumPruefen = False
     
    End Function
     
  5. wo müsste ich denn diesen Teil einbauen?[br][br]Erstellt am: 28.03.08 um 12:58:33[hr][br]geht leider nicht.
    Der stoppt bei:
    Zelle.NumberFormat = sFormat

    mit der Fehlermeldung:
    Die Number Format Eigenschaft des Range-Objekts kann nicht festgelegt werden

    Woran liegt das?
     
  6. Hallo joergi78,

    dieser Code sollte komplett in der Code-Seite der Arbeitsmappe ('DieseArbeitsmappe') liegen.

    Wenn du mir ein Probe-Exemplar deiner Arbeitsmappe an mein Mail-addy schickst, bau ich dir das Makro ein. Für eine Fehlerverfolgung wäre das auch von Vorteil.

    Gruß Matjes :)
     
Die Seite wird geladen...

Drucken nach Zellenabfrage - Ähnliche Themen

Forum Datum
Drucken auf Netzwerkdrucker nicht mehr möglich nach Wechsel von NIS zu F-Secure Windows 95-2000 7. Okt. 2007
Automatisches Reboot nach Windows-Update unterdrücken Windows XP Forum 25. Dez. 2006
Verbindung zu Server bricht nach Drucken ab Windows XP Forum 8. Sep. 2005
von hinten nach vorne drucken Sonstiges rund um den PC & Kaufberatung 26. Sep. 2004
drucken der Testseite nach Patronenwechsel ausschalten Windows XP Forum 12. Sep. 2003