Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
892to896
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Fehler im Code!

Fehler im Code!
31.07.2007 13:57:28
Frank
Hallo!
Ich möchte eine neue Abfrage in den bestehenden Code einer Userform einbauen. Leider klappt mir die Zusammenführung nicht richtig. Hier der derzeitige Code:
Option Explicit
Dim rngFind As Range
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const WS_SYSMENU As Long = &H80000
Private hWndForm As Long
Private bCloseBtn As Boolean
Private Sub CommandButton3_ändern_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
Application.Run "UF_Show"
End Sub
Private Sub CommandButton3_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
'Neuen Datensatz anlegen
Dim letzte_Zeile As Long
With Worksheets("Daten")
'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = TextBox1.Text 'ID
.Cells(letzte_Zeile, 2) = TextBox2.Text 'Nachname
.Cells(letzte_Zeile, 3) = TextBox3.Text 'Vorname
.Cells(letzte_Zeile, 8) = TextBox4.Text 'Geburtsdatum
.Cells(letzte_Zeile, 5) = TextBox5.Text 'Adresse
.Cells(letzte_Zeile, 6) = TextBox6.Text 'PLZ
.Cells(letzte_Zeile, 7) = TextBox7.Text 'Ort
.Cells(letzte_Zeile, 4) = TextBox8.Text 'beschäftigt seit
.Cells(letzte_Zeile, 9) = TextBox9.Text 'Telefon
.Cells(letzte_Zeile, 10) = TextBox10.Text 'Mobil
.Cells(letzte_Zeile, 11) = TextBox11.Text 'E-MAil
.Cells(letzte_Zeile, 19) = TextBox12.Text 'eingearbeitet FS
.Cells(letzte_Zeile, 20) = TextBox13.Text 'eingearbeitet Bar
.Cells(letzte_Zeile, 21) = TextBox14.Text 'Konfektionsgröße
.Cells(letzte_Zeile, 22) = TextBox15.Text 'VS Tauglich
.Cells(letzte_Zeile, 25) = TextBox16.Text 'Wochenstunden
.Cells(letzte_Zeile, 26) = TextBox17.Text 'Kostenstelle
.Cells(letzte_Zeile, 27) = TextBox18.Text 'Stunden pro Monat
.Cells(letzte_Zeile, 28) = TextBox19.Text 'Überstunden
.Cells(letzte_Zeile, 24) = TextBox20.Text 'Bermerkungen
.Cells(letzte_Zeile, 12) = ComboBox1.Text 'Bereich 1
.Cells(letzte_Zeile, 13) = ComboBox2.Text 'Bereich 2
.Cells(letzte_Zeile, 14) = ComboBox3.Text 'Bereich 3
.Cells(letzte_Zeile, 15) = ComboBox5.Text 'Sprache 1
.Cells(letzte_Zeile, 16) = ComboBox6.Text 'Sprache 2
.Cells(letzte_Zeile, 17) = ComboBox7.Text 'Sprache 3
.Cells(letzte_Zeile, 18) = ComboBox8.Text 'Sprache 4
End With
ClearAll
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
Unload grüne_Welle_1
End Sub
Private Sub CommandButton5_Click()
If TextBox1.Text = "" Then
Unload grüne_Welle_1
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload grüne_Welle_1
End If
End Sub
Private Sub CommandButton4_Click()
Dim a As Integer
Dim msg
'Datensatz löschen
a = Range(rngFind.Address).Row
If MsgBox(" Datensatz wirklich löschen", vbYesNo) = vbNo Then
Exit Sub
Else
Rows(a).Delete
End If
ClearAll
TextBox1.SetFocus
End Sub
Private Sub CommandButton6_Click()
Sheets("Daten").Select
ActiveSheet.Unprotect Password:="dolphin"
Dim aStr As Byte
If TextBox1.Text = "" Then
ClearAll
TextBox1.SetFocus
Exit Sub
Else
aStr = MsgBox(" Möchten Sie den angezeigten Datensatz" & vbCrLf & vbCrLf & vbTab & _
"- vorher speichern (Ja)" & vbCrLf & vbCrLf & vbTab & _
"- nur leeren (Nein)" & vbCrLf & vbCrLf & vbTab & _
"- nicht unternehmen (Abbrechen)", vbYesNoCancel, "Sicherheitsabfrage")
If aStr = vbYes Then
CommandButton3_ändern_Click
ElseIf aStr = vbNo Then
ClearAll
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
Else
TextBox1.SetFocus
End If
TextBox1.SetFocus
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="dolphin"
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Public Sub UserForm_Initialize()
If Val(Application.Version) >= 9 Then
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Else
hWndForm = FindWindow("ThunderXFrame", Me.Caption)
End If
bCloseBtn = False
SetUserFormStyle
ComboBox1.RowSource = "'Alter'!A2:C8"
ComboBox2.RowSource = "'Info'!B2:B9"
ComboBox3.RowSource = "'Info'!C2:C9"
ComboBox5.RowSource = "'Info'!E2:E9"
ComboBox6.RowSource = "'Info'!E2:E9"
ComboBox7.RowSource = "'Info'!E2:E9"
ComboBox8.RowSource = "'Info'!F2:F9"
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
End Sub
Private Sub SetUserFormStyle()
Dim frmStyle As Long
If hWndForm = 0 Then Exit Sub
frmStyle = GetWindowLong(hWndForm, GWL_STYLE)
If bCloseBtn Then
frmStyle = frmStyle Or WS_SYSMENU
Else
frmStyle = frmStyle And Not WS_SYSMENU
End If
SetWindowLong hWndForm, GWL_STYLE, frmStyle
DrawMenuBar hWndForm
End Sub
Private Sub optCloseOn_Click()
bCloseBtn = True
cmdBeenden.Cancel = True
SetUserFormStyle
End Sub
Private Sub optCloseOff_Click()
bCloseBtn = False
cmdBeenden.Cancel = False
SetUserFormStyle
End Sub
Sub ClearAll()
Dim C As Integer
On Error Resume Next
For C = 1 To 8
Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 20
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
Image2.Picture = LoadPicture("")
End Sub
Private Sub UserForm_Activate()
Dim lZeile As Long
Dim lCoBox As Long
With Worksheets("Alter")
With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "1 cm; 1 cm; 1 cm"
For lZeile = 1 To Range("A65536").End(xlUp).Row
.AddItem " "

Hier hängt sich der Code bei der Initialisierung auf...


.List(lCoBox, 0) = Range("A" & lZeile).Value
.List(lCoBox, 1) = Range("B" & lZeile).Value
.List(lCoBox, 2) = Range("C" & lZeile).Value
lCoBox = lCoBox + 1
Next lZeile
End With
End With
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iAlter As Integer
Dim iLiBo As Integer
If Me.TextBox4.Value "" Then
If IsDate(Me.TextBox4.Value) Then
If (Month(Date) (Month(Date) = Month(CDate(TextBox4.Value))) And _
Day(CDate(TextBox4.Value)) > Day(Date) Then
iAlter = (Year(Date) - _
Year(CDate(TextBox4.Value))) - 1
Else
iAlter = Year(Date) - _
Year(CDate(TextBox4.Value))
End If
Me.TextBox21.Value = iAlter
If iAlter 99 Then Exit Sub
For iLiBo = 0 To Me.ComboBox1.ListCount
If iAlter >= Me.ComboBox1.List(iLiBo, 1) And _
iAlter Me.ComboBox1.ListIndex = iLiBo
Exit For
End If
Next iLiBo
End If
End If
End Sub
Leider ist die Datei zu groß zum Hochladen. Ich hoffe, mir kann trotzdem jemand helfen...
Gruß Frank

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler im Code!
31.07.2007 14:23:00
Luschi
Hallo Frank,
lt. ExcelXP-Vba-Hilfe initialiesiert man mehrspaltige Listenfelder so:

Private Sub UserForm_Initialize()
Dim i As Single
ListBox1.ColumnCount = 3
'This list box contains 3 data columns
'Load integer values MyArray
For i = 0 To 5
MyArray(i, 0) = i
MyArray(i, 1) = Rnd
MyArray(i, 2) = Rnd
Next i
'Load ListBox1
ListBox1.List() = MyArray
End Sub

Man schreibt also die zu übernehmenden Werte in ein Array und übernimmt dann die Array-Werte mit der List-Methode in das Listenfeld.
Gruß von Luschi
aus klein-Paris

Anzeige
AW: Fehler im Code!
31.07.2007 15:01:47
Frank
Hallo!
Sorry aber damit komme ich nicht weiter. Der Code alleine (im separater Userform) klappt ja auch anstandslos. Einen Fehler habe ich bereits gefunden. im Sub UserForm_Initialize() habe ich die RowSource für die ComboBox1 bereits programmiert gehabt. Daher kam der Fehler vermutlich. Jetzt hängt aber das nächste Sub:

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iAlter  As Integer
Dim iLiBo   As Integer
If Me.TextBox4.Value  "" Then
If IsDate(Me.TextBox4.Value) Then
If (Month(Date)  Day(Date) Then
iAlter = (Year(Date) - _
Year(CDate(TextBox4.Value))) - 1
Else
iAlter = Year(Date) - _
Year(CDate(TextBox4.Value))
End If
Me.TextBox21.Value = iAlter
If iAlter  99 Then Exit Sub
For iLiBo = 0 To Me.ComboBox1.ListCount
            If iAlter >= Me.ComboBox1.List(iLiBo, 1) And _
iAlter 
Me.ComboBox1.ListIndex = iLiBo
Exit For
End If
Next iLiBo
End If
End If
End Sub


Ich steig da nicht mehr durch...

Anzeige
AW: Fehler im Code!
31.07.2007 16:59:59
Peter
Hallo Frank,
wo hängt das Makro?
Bei mir hat das Original einwandfrei funktioniert.
Gruß Peter

AW: Fehler im Code!
31.07.2007 17:49:00
Frank
Hallo!
Ich weiß, selbst noch in der Überarbeitung (in der Einzeldatei), aber beim Zusammenschreiben der Codes werde ich irgendwas falsch gemacht haben.
Das Makro hängt sich hier auf:
If iAlter >= Me.ComboBox1.List(iLiBo, 1) And _
iAlter

AW: Fehler im Code!
31.07.2007 18:14:00
Frank
Hallo nochmal!
Ich habe alles was irgend ging aus der Datei rausgeschmissen um den inhalt zu schrumpfen. Hier ist die verkleinerte Datei:
https://www.herber.de/bbs/user/44639.xls
Ich hoffe, das hilf weiter!
Vielen Dank im Voraus
Gruß Frank

Anzeige
AW: Fehler im Code!
31.07.2007 21:27:00
Peter
Hallo Frank,
deine Mappe kann ich nicht richtig öffnen.
Ich fahre noch Excel 2000 und da sind einige deiner Declares nicht ladbar für mich.
Ich bekomme beim Debuggen - Kompilieren von VBAProjekt den Hinweis
Schwerwiegender Kompilierungs-Fehler
Mein Excel stirbt beim Laden deines UserForms und ich kann nur noch mein gesamtes System runter und rauffahren. Nachdem ich das nun dreimal gemacht habe, habe ich deine Mappe wieder aus meinem System gelöscht.
Ich steige also hier aus, so leid es mir tut, ich möchte keine weiteren Abstürze riskieren.
Gruß Peter

Anzeige
AW: Fehler im Code!
31.07.2007 21:32:00
Frank
OK - verstehe ich. Trotzdem danke fürs versuchen!

AW: Fehler im Code!
31.07.2007 21:42:58
Peter
Hallo Frank,
ich bin es nochmal.
Für mich sieht der aufgetretene Fehler so aus, als wenn die ComboBox1 nicht, oder nicht komplett gefüllt ist. Bevor du in TextBox4 etwas eingibst, Klick doch einmal auf die ComboBox1 und sieh dir die Werte an.
Gruß Peter

AW: Fehler im Code!
31.07.2007 22:04:00
Frank
Hallo!
Ja stimmt! Er such im Arbeitsblatt "Daten" nicht in "Info" daher der Fehler. Aber das Makro ist doch eindeutig mit "Info" verknüpft?

Private Sub UserForm_Activate()
Dim lZeile  As Long
Dim lCoBox  As Long
With Worksheets("Info") 
With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "1 cm; 1 cm; 1 cm"
For lZeile = 1 To Range("A65536").End(xlUp).Row
.AddItem " "
.List(lCoBox, 0) = Range("G" & lZeile).Value
.List(lCoBox, 1) = Range("H" & lZeile).Value
.List(lCoBox, 2) = Range("I" & lZeile).Value
lCoBox = lCoBox + 1
Next lZeile
End With
End With
End Sub


Der Code enthält ja noch ein anderes Makro, das die Bezüge der restlichen ComboBoxen steuert. Kann das hieran liegen?


Public Sub UserForm_Initialize()
If Val(Application.Version) >= 9 Then
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Else
hWndForm = FindWindow("ThunderXFrame", Me.Caption)
End If
bCloseBtn = False
SetUserFormStyle
ComboBox2.RowSource = "'Info'!B2:B9"
ComboBox3.RowSource = "'Info'!C2:C9"
ComboBox5.RowSource = "'Info'!E2:E9"
ComboBox6.RowSource = "'Info'!E2:E9"
ComboBox7.RowSource = "'Info'!E2:E9"
ComboBox8.RowSource = "'Info'!F2:F9"
Me.TextBox1 = WorksheetFunction.Max(Range("a:a")) + 1
End Sub


Wenn ich die Datei neu gestartet habe und das Markro "UserForm_Activate" über den VBA Editor starte funktioniert es nämlich auch erstmal. Deshalb habe ich den Fehler auch nicht so schnell gefunden. Leider klappt es immer nur einmal.
Gruß Frank

Anzeige
AW: Fehler im Code!
31.07.2007 22:10:27
Frank
OK! Ich habs!
Ist zwar nicht schick, funktioniert aber ;-)

Private Sub UserForm_Activate()
Sheets("Info").Select
Dim lZeile  As Long
Dim lCoBox  As Long
With Worksheets("Info")
With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "1 cm; 1 cm; 1 cm"
For lZeile = 1 To Range("A65536").End(xlUp).Row
.AddItem " "
.List(lCoBox, 0) = Range("G" & lZeile).Value
.List(lCoBox, 1) = Range("H" & lZeile).Value
.List(lCoBox, 2) = Range("I" & lZeile).Value
lCoBox = lCoBox + 1
Next lZeile
End With
End With
Sheets("Daten").Select
End Sub


Gruß Frank und nochmals vielen Dank für die Hilfe!!!

Anzeige
AW: Fehler im Code!
01.08.2007 11:03:19
Peter
Hallo Frank,
du solltest besser nicht UserForm_Initialize und UserForm_Activate für ein UserForm(ular) gleichzeitig verwenden.
Vereinige das in Acitvate - das ist die bessere Alternative.
Gruß Peter

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige