Excel 2007 VBA

06/05/2008 - 15:08 von Reinhold Diels | Report spam
Hallo zusammen,

ich habe eine MultiPage mit vier Seiten eingerichtet mit einem Kombi-Feld
als Kalender. Über diverse Textboxen und den Kalender (auf jeder Seite
einmal) werden Daten abgefragt, die dann in eine Tabelle übertragen werden
sollen.
Nun mein Problem: Wenn auf einer der Seiten keine Eintràge sind, darf auch
das Datum nicht in die vorgesehene Tabelle übetragen werden. Dafür habe ich
bisher folgendes geschrieben:

Private Sub Übernehmen_Click()
Set frm = UserForm1
Sheets("Tabelle1").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
With frm
ActiveCell.Value = .DTPicker1.Value
ActiveCell.Offset(0, 1).Value = .TextBox2.Value
ActiveCell.Offset(0, 2).Value = .TextBox3.Value
ActiveCell.Offset(0, 3).Value = .TextBox4.Value
ActiveCell.Offset(0, 4).Value = .TextBox5.Value
ActiveCell.Offset(0, 5).Value = .TextBox6.Value
ActiveCell.Offset(0, 6).Value = .TextBox7.Value
ActiveCell.Offset(0, 7).Value = .TextBox8.Value
ActiveCell.Offset(0, 8).Value = .TextBox9.Value
End With
Sheets("Tabelle2").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
With frm
ActiveCell.Value = .DTPicker2.Value
ActiveCell.Offset(0, 1).Value = .TextBox11.Value
ActiveCell.Offset(0, 2).Value = .TextBox12.Value
ActiveCell.Offset(0, 3).Value = .TextBox13.Value
ActiveCell.Offset(0, 4).Value = .TextBox14.Value
ActiveCell.Offset(0, 5).Value = .TextBox15.Value
ActiveCell.Offset(0, 6).Value = .TextBox16.Value
ActiveCell.Offset(0, 7).Value = .TextBox17.Value
End With
Sheets("Tabelle3").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
With frm
ActiveCell.Value = .DTPicker3.Value
ActiveCell.Offset(0, 1).Value = .TextBox22.Value
ActiveCell.Offset(0, 2).Value = .TextBox23.Value
ActiveCell.Offset(0, 3).Value = .TextBox24.Value
ActiveCell.Offset(0, 4).Value = .TextBox26.Value
ActiveCell.Offset(0, 5).Value = .TextBox27.Value
ActiveCell.Offset(0, 6).Value = .TextBox28.Value
End With
Sheets("Tabelle4").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
With frm
ActiveCell.Value = .DTPicker4.Value
ActiveCell.Offset(0, 1).Value = .TextBox30.Value
ActiveCell.Offset(0, 2).Value = .TextBox31.Value
ActiveCell.Offset(0, 3).Value = .TextBox32.Value
ActiveCell.Offset(0, 4).Value = .TextBox35.Value
End With
Sheets("Tabelle1").Select
Unload Me
End Sub

Den Befehl nur dann zu übertragen, wenn eine der Textboxen auf der Seite
befüllt ist, bekomme ich nicht hin.

Kann mir jemand helfen ?
 

Lesen sie die antworten

#1 Melanie Breden
06/05/2008 - 16:17 | Warnen spam
Hallo Reinhold,

"Reinhold Diels" schrieb:
Nun mein Problem: Wenn auf einer der Seiten keine Eintràge sind, darf auch
das Datum nicht in die vorgesehene Tabelle übetragen werden.

Den Befehl nur dann zu übertragen, wenn eine der Textboxen auf der Seite
befüllt ist, bekomme ich nicht hin.



im Prinzip wiederholt sich der Code ja vier mal mit jeweils geringen Änderungen.
Diese Code-Wiederholungen würde ich in Funktionen/Prozeduren ausgelagern.

Speicher folgende Prozeduren im Codemodul der UserForm1:

Private Sub Übernehmen_Click()
' Nummerierungen der TextBoxen angeben
' (Bsp: TextBox2 bis TextBox9)
If CheckTextBoxes(2, 9) = True Then
SetDateValues wks:=Worksheets("Tabelle1"), lngDT:=1, lngTo:=9, lngTB:=0
End If

If CheckTextBoxes(11, 17) = True Then
SetDateValues wks:=Worksheets("Tabelle2"), lngDT:=2, lngTo:=8, lngTB:=9
End If

If CheckTextBoxes(22, 28) = True Then
SetDateValues wks:=Worksheets("Tabelle3"), lngDT:=3, lngTo:=7, lngTB:
End If

If CheckTextBoxes(30, 35) = True Then
SetDateValues wks:=Worksheets("Tabelle4"), lngDT:=4, lngTo:=5, lngTB:(
End If

Unload Me
End Sub

Public Function CheckTextBoxes(lngFrom As Long, lngTo As Long) As Boolean
Dim i As Long

For i = lngFrom To lngTo
If UserForm1.Controls("TextBox" & i).Text <> "" Then
CheckTextBoxes = True
Exit Function
End If
Next i
End Function

Public Sub SetDateValues(wks As Worksheet, lngDT As Long, lngTo As Long, lngTB As Long)
Dim lngLastRow As Long
Dim lngRow As Long

With wks
lngLastRow = .Range("A65536").End(xlUp).Row + 1
.Cells(lngLastRow, 1).Value = UserForm1.Controls("DTPicker" & lngDT).Value
For lngRow = 2 To lngTo
.Cells(lngLastRow, lngRow).Value = Controls("TextBox" & lngRow + lngTB).Text
Next lngRow
End With
End Sub


Mit freundlichen Grüssen
Melanie Breden

- Microsoft MVP für Excel -
www.melanie-breden.de
Das Excel-VBA Codebook 2007 http://tinyurl.com/2nwvod

Ähnliche fragen