UserForm in Outlook mit DropDowns aus Excel (Inhal
05.08.2008 20:49:53
Meier
ich habe ein UserForm aus MS Excel in MS Outlook importiert.
Neben mehreren Funktionen im UserForm werden DropDowns durch Werte aus Excel gefüllt. Das funktioniert, dank Unterstützung von ChristianM in diesem Forum Forum recht gut. Herzlichen Dank nochmal.
Nun möchte/muss ich das UserForm in Outlook verwenden und um Outlook-spezifische Funktionen erweitern.
Hierzu habe ich erstmal das UserForm aus Excel exportiert und in Outlook importiert. Hat auch alles geklappt.
Die DrowDwon-Inhalte sollen jedoch weiterhin aus der Excel kommen. Also, wenn ich nach meiner Google-Recherche das so richtig verfolge, sollte es ja nicht sehr schwer sein, einen bestehenden Excel-VBA-Code auf Outlook umzumünzen. Aber irgendwie komme ich nicht weiter. Mir fehlt sogar der Ansatz, obwohl ich schon einiges im Netz hierzu und in der Online Hilfe gelesen habe.
So schwer kann das doch nicht sein, oder?
Vielleicht kann mir ja jemand helfen.
Herzlichen Dank
Gruß Jörg
Private Sub UserForm_Initialize()
'Beim Aufruf der UserForm soll das DrobDown cmbAktenzeichen mit Werten aus
einem Excel-Sheet gefüllt werden.
'Variablendeklaration
1 Dim sList() As String
2 Dim I As Long, k As Long
Dim appWD As Excel.Application
Set appWD = CreateObject("Excel.Sheet")
'cmbAktenzeichen füllen
3 ReDim sList(k)
4 With Sheets("EAPL")
5 sList(k) = .Cells(2, 1)
6 For I = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
7 If IsError(Application.Match(.Cells(I, 1), sList, 0)) Then
8 k = k + 1
9 ReDim Preserve sList(k)
10 sList(k) = .Cells(I, 1)
11 End If
12 Next
13 End With
14 Me.cmbAktenzeichen.List = sList
'cmbVorgang und cmbBand deaktivieren
15 Me!cmbVorgang.Enabled = False
16 Me!cmbBand.Enabled = False
'cmbAbsender füllen
17 Dim rList() As String
18 Dim J As Long, L As Long
19 ReDim rList(L)
20 With Sheets("Absender")
21 rList(L) = .Cells(2, 1)
22 For J = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
23 If IsError(Application.Match(.Cells(I, 1), rList, 0)) Then
24 L = L + 1
25 ReDim Preserve rList(L)
26 rList(L) = .Cells(J, 1)
27 End If
28 Next
29 End With
30 Me.cmbAbsender.List = rList
End Sub
Private Sub cmbAktenzeichen_Change()
'Nach Auswahl des Wertes im DropDwon cmbAktenzeichen soll das DrobDown cmbV
organg mit Werten aus einem Excel-Sheet gefüllt werden.
'Variablendeklaration
1 Dim sList() As String
2 Dim I As Long, k As Long
3 Me.cmbVorgang.Clear
4 Me.txtVorgang = ""
5 ReDim sList(k)
6 With Sheets("EAPL")
7 For I = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
8 If .Cells(I, 1) = Me.cmbAktenzeichen.Text Then
9 If IsError(Application.Match(.Cells(I, 3), sList, 0)) Then
10 ReDim Preserve sList(k)
11 sList(k) = .Cells(I, 3)
12 k = k + 1
13 End If
14 Me!txtAktenzeichen = .Cells(I, 2)
15 End If
16 Next
17 End With
18 Me.cmbVorgang.List = sList
19 Me!cmbVorgang.Enabled = True
20 Me!cmbBand.Enabled = False
End Sub