AW: VBA Lösung gesucht
23.08.2006 09:03:05
Heiko
Hallo Josef,
richtig wäre es sowas mit einem Klassenmodul zu machen, damit kannst du dann alle 174 Textboxen zusammenfassen und gezielt auf Änderungen einer dieser Textboxen reagieren.
Dazu gibt es hier http://www.online-excel.de/excel/grusel_vba.php?f=7 eine gute Einführung. Wenn dir das noch zu kompliziert ist, dann hilft vielleicht mein Vorschlag, wie du das dann für die weiteren Spalten machst mußt du selbst mal probieren.
Hier mein Vorschlag:
Function GibZahl(strText As String) As Variant
' Die Function GibZahl gibt die erste in der übergebene Zeichenfolge enthaltene Zahl zurück.
' strText = Die Zeichenfolge auf Zahlen hin durchsucht werden soll.
' Aufruf z.B. so:
' MsgBox GibZahl("ksj 08,15hka") Gib 8,15 zurück
' MsgBox GibZahl("ksj kagg d") Gib FALSE bzw Falsch zurück
' MsgBox GibZahl("ksj 1234kagg w32552 d") Gib 1234 zurück
Dim lngI As Long
' Da Val nur den Punkt als Dezimaltrennzeichen erkennt, mal schnell alle Kommas im Text gegen
' Punkte austauschen damit auch Zahlen mit Kommas als Dezimaltrennzeichen erkannt werden.
strText = Replace(strText, ",", ".")
For lngI = 1 To Len(strText)
If IsNumeric(Mid(strText, lngI, 1)) Then
' Wenn Zahlen gefunden wurden, dann diese Zahl zurückgeben
GibZahl = Val(Right(strText, Len(strText) - lngI + 1))
Exit Function
End If
Next lngI
' Wenn keine Zahl im Text enthalten ist dann FALSE zurückgeben.
GibZahl = False
End Function
Sub TuWas(strControlName As String)
Dim varN As Variant
On Error Resume Next
Dim wks As Worksheet
Set wks = Worksheets("Anzahl Filme 2006")
varN = GibZahl(strControlName)
If VarType(varN) <> vbBoolean Then
' Wie du das dann für die weiteren Spalten machst, z.B. mit Select Case mußte mal probieren.
wks.Range("D" & varN - 26) = Me.Controls(strControlName).Text
ThisWorkbook.Save
End If
End Sub
Private Sub film30_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TuWas (Me.ActiveControl.Name)
End Sub
Private Sub film31_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TuWas (Me.ActiveControl.Name)
End Sub
Private Sub film32_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TuWas (Me.ActiveControl.Name)
End Sub
Private Sub film33_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TuWas (Me.ActiveControl.Name)
End Sub
Private Sub film34_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TuWas (Me.ActiveControl.Name)
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !