Moin zusammen,
bin blutiger Anfänger in VBA, habe mich in den letzten Tagen aber mit der Materie auseinander gesetzt und ein Programm aus verschiedenen Teilen gestaltet.
Was jetzt als I-Tüpfelchen noch fehlt, ist das beim Start von EXCEL das VBA-programm automatisch ausgeführt wird.
Habe mit AutoOpen alles probiert, tírgendwie ist da der Wurm drin
Anbei noch der Programm-Code:
Option Explicit
Private Sub ComboBox1_Click()
If ComboBox1.ListIndex <> 0 Then
TextBox1 = Cells(ComboBox1.ListIndex + 1, 1)
TextBox2 = Cells(ComboBox1.ListIndex + 1, 2)
TextBox3 = Cells(ComboBox1.ListIndex + 1, 3)
TextBox4 = Cells(ComboBox1.ListIndex + 1, 4)
TextBox5 = Cells(ComboBox1.ListIndex + 1, 5)
ComboBox2 = Cells(ComboBox1.ListIndex + 1, 6)
Else
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
ComboBox2 = ""
End If
End Sub
Private Sub ComboBox1_Change()
ComboBox2.RowSource = "Verantwortlicher!b1:b7"
End Sub
Private Sub CommandButton1_Click()
Sheets("Neuer Eintrag").Activate
Dim xZeile As Long
If TextBox1 = "" Then Exit Sub
If ComboBox1.ListIndex = 0 Then
xZeile = [A65536].End(xlUp).Row + 1
Else
xZeile = ComboBox1.ListIndex + 1
End If
Cells(xZeile, 1) = TextBox1
Cells(xZeile, 2) = TextBox2
Cells(xZeile, 3) = TextBox3
Cells(xZeile, 4) = TextBox4
Cells(xZeile, 5) = TextBox5
Cells(xZeile, 6) = ComboBox2
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
ComboBox2 = ""
Dim Zeile As Long
Zeile = Range("A65536").End(xlUp).Offset(1, 0).Row
Columns("A:C").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
UserForm_Initialize
Dim strTabelle As String
Dim wsTabelle As Worksheet
strTabelle = "Neuer Eintrag"
For Each wsTabelle In ThisWorkbook.Sheets
If wsTabelle.Name = strTabelle Then
Application.ScreenUpdating = False
Sheets(strTabelle).Copy
ActiveWorkbook.SendMail ThisWorkbook.Worksheets("Neuer Eintrag").Cells(2, 6), "Neue Änderungsmitteilung siehe unten"
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Exit For
Else
If wsTabelle.Name = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name Then MsgBox "Diese Tabelle gibt es nicht"
End If
Next wsTabelle
If ComboBox1.ListIndex > 0 Then
Sheets("Liste").Activate
If TextBox1 = "" Then Exit Sub
If ComboBox1.ListIndex = 0 Then
xZeile = [A65536].End(xlUp).Row + 1
Else
xZeile = ComboBox1.ListIndex + 1
End If
Cells(xZeile, 1) = TextBox1
Cells(xZeile, 2) = TextBox2
Cells(xZeile, 3) = TextBox3
Cells(xZeile, 4) = TextBox4
Cells(xZeile, 5) = TextBox5
Cells(xZeile, 6) = ComboBox2
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
ComboBox2 = ""
Zeile = Range("A2").End(xlUp).Offset(1, 0).Row
Columns("A:C").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
UserForm_Initialize
End If
End Sub
Private Sub CommandButton3_Click()
Dim lngFreieZeile As Long
With Worksheets("Liste")
lngFreieZeile = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & lngFreieZeile & ":f" & lngFreieZeile).Value = Worksheets("Liste").Range("A2:F2").Value
End With
Range("A2:F2").Select
Selection.Cut
Sheets("Liste").Select
Range("A2").Select
ActiveSheet.Paste
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim aRow, i As Long
Application.EnableEvents = False
ComboBox1.Clear
aRow = [A65536].End(xlUp).Row
ComboBox1.AddItem "Neue Änderungsmitteilung"
For i = 2 To aRow
ComboBox1.AddItem Cells(i, 1) & ", " & Cells(i, 2)
Next i
ComboBox1.ListIndex = 0
Application.EnableEvents = True
End Sub
PS. AutoOpen habe ich wieder entfernt.
Für schnelle Hilfe biin ich dankbar.
Gruß
Michael
|