AW: Textboxen füllen wenn leer
07.12.2007 20:06:00
Heiko
Hallo Fred,
da du nicht gesagt hast ob es Textboxen aus der Toolbox oder aus der Formularbox sind, bin ich mal von Textboxen aus der Toolbox ausgegangen.
Ausserdem geht mein Code davon aus, das das Tabellenblatt mit den Tb´s das aktive ist zum Zeitpunkt des Druckes.
In das Codefenster von DieseArbeitsmappe:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
TextRein
End Sub
Und dies in ein allgemeines Modul:
Option Explicit
Public ArrWoWarWasDrin() As String
Public Sub TextRein()
Dim objTB As Object
Dim intArrCounter As Integer
Erase ArrWoWarWasDrin
For Each objTB In ActiveSheet.OLEObjects
If TypeName(objTB.Object) = "TextBox" Then
If objTB.Object.Text = "" Then
objTB.Object.Text = "Kein Fehler"
ReDim Preserve ArrWoWarWasDrin(intArrCounter)
ArrWoWarWasDrin(intArrCounter) = objTB.Name
intArrCounter = intArrCounter + 1
End If
End If
Next objTB
' Da es kein Ereignis AfterPrint gibt, muss man sich hier mit einer Krücke behelfen
' und das TextRaus einfach ein paar Sekunden nach TextRein starten.
Application.OnTime Now + TimeValue("00:00:05"), "TextRaus"
End Sub
Public Sub TextRaus()
Dim intArrCounter As Integer
For intArrCounter = LBound(ArrWoWarWasDrin) To UBound(ArrWoWarWasDrin)
ActiveSheet.OLEObjects(ArrWoWarWasDrin(intArrCounter)).Object.Text = ""
Next intArrCounter
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !!!