Thema Datum  Von Nutzer Rating
Antwort
Rot Word Userform Excel-Abfragen zusammenfassen
 23.10.2015 20:20:19 xtoph
NotSolved

Ansicht des Beitrags:
Von:
xtoph		 Datum:
23.10.2015 20:20:19		 Views:
1639		 Rating:
     
Antwort:
  Ja
Thema:
Word Userform Excel-Abfragen zusammenfassen

Hallo,

ich hoffe, Ihr könnt mir helfen. Und zwar habe ich mir eine Word-Briefvorlage gebastelt, welche beim Start Adressen aus einer Exceldatei abfragt und die Einträge an den entsprechenden Textmarken platziert. Soweit so gut. Jetzt wollte ich aus der selben Datei weitere Abfragen aus den unterschiedlichen Sheets integrieren. Dies funktioniert auch jedes für sich gut. Mein Problem ist, das alle Abfragen mittels der gleichen Userform gemacht werden sollen und die Einträge in die selbe Word-Vorlage ausgegeben werden soll. Kurz um kann mir jemand dabei behilflich sein aus nachfolgenden 4 Codes einen Code zu machen???

1. ListBox1

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Option Explicit
Private Const sAdressDatei As String = _
     "adress.xlsx"
 
Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     If ListBox1.ListIndex >= 0 Then
     
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
         lZeile = 2
         With oExcelWorkbook.sheets("adress")
             Do While .Cells(lZeile, 1) <> ""
                 If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
                     ActiveDocument.Bookmarks("Textmarke_Firma").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     ActiveDocument.Bookmarks("Textmarke_Straße").Range.Text = _
                         CStr(.Cells(lZeile, 7).Value)
                     ActiveDocument.Bookmarks("Textmarke_Ort").Range.Text = _
                         CStr(.Cells(lZeile, 8).Value)
                     ActiveDocument.Bookmarks("Textmarke_PLZ").Range.Text = _
                         CStr(.Cells(lZeile, 9).Value)
                     ActiveDocument.Bookmarks("Textmarke_Land").Range.Text = _
                         CStr(.Cells(lZeile, 10).Value)
                     ActiveDocument.Bookmarks("Textmarke_Anrede").Range.Text = _
                         CStr(.Cells(lZeile, 14).Value)
                     ActiveDocument.Bookmarks("Textmarke_Person").Range.Text = _
                         CStr(.Cells(lZeile, 15).Value)
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
        
         oExcelWorkbook.Close False
         oExcelApp.Quit
     
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If
 
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub
 
Private Sub CommandButton2_Click()
     Unload Me
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub ListBox1_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
     ListBox1.Clear
     lZeile = 2
     With oExcelWorkbook.sheets("adress")
         Do While .Cells(lZeile, 1) <> ""
             ListBox1.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
        
     oExcelWorkbook.Close False
     oExcelApp.Quit
       
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub

2. ComboBox 1

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Option Explicit
Private Const sAdressDatei As String = _
     "adress.xlsx"
 
Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     If ComboBox1.ListIndex >= 0 Then
     
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
         lZeile = 2
         With oExcelWorkbook.sheets("firm")
             Do While .Cells(lZeile, 1) <> ""
                 If ComboBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
                     ActiveDocument.Bookmarks("Textmarke_BezDatei").Range.Text = _
                         CStr(.Cells(lZeile, 3).Value)
                     ActiveDocument.Bookmarks("Textmarke_BezBetreff").Range.Text = _
                         CStr(.Cells(lZeile, 4).Value)
                     ActiveDocument.Bookmarks("Textmarke_Auftragsnummer").Range.Text = _
                         CStr(.Cells(lZeile, 5).Value)
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
        
         oExcelWorkbook.Close False
         oExcelApp.Quit
     
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If
 
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub
 
Private Sub CommandButton2_Click()
     Unload Me
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub ComboBox1_Click()
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
     ComboBox1.Clear
     lZeile = 2
     With oExcelWorkbook.sheets("firm")
         Do While .Cells(lZeile, 1) <> ""
             ComboBox1.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
        
     oExcelWorkbook.Close False
     oExcelApp.Quit
       
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub
ComboBox2
Option Explicit
Private Const sAdressDatei As String = _
     "adress.xlsx"
 
Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     If ComboBox2.ListIndex >= 0 Then
     
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
         lZeile = 2
         With oExcelWorkbook.sheets("signature")
             Do While .Cells(lZeile, 1) <> ""
                 If ComboBox2.Text = CStr(.Cells(lZeile, 2).Value) Then
                     ActiveDocument.Bookmarks("Textmarke_Unterschrift1").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
        
         oExcelWorkbook.Close False
         oExcelApp.Quit
     
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If
 
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub
 
Private Sub CommandButton2_Click()
     Unload Me
End Sub
 
 
Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
     ComboBox2.Clear
     lZeile = 2
     With oExcelWorkbook.sheets("signature")
         Do While .Cells(lZeile, 1) <> ""
             ComboBox2.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
        
     oExcelWorkbook.Close False
     oExcelApp.Quit
       
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub

3. ComboBox2

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Option Explicit
Private Const sAdressDatei As String = _
     "adress.xlsx"
 
Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     If ComboBox2.ListIndex >= 0 Then
     
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
         lZeile = 2
         With oExcelWorkbook.sheets("signature")
             Do While .Cells(lZeile, 1) <> ""
                 If ComboBox2.Text = CStr(.Cells(lZeile, 2).Value) Then
                     ActiveDocument.Bookmarks("Textmarke_Unterschrift1").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
        
         oExcelWorkbook.Close False
         oExcelApp.Quit
     
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If
 
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub
 
Private Sub CommandButton2_Click()
     Unload Me
End Sub
 
 
Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
     ComboBox2.Clear
     lZeile = 2
     With oExcelWorkbook.sheets("signature")
         Do While .Cells(lZeile, 1) <> ""
             ComboBox2.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
        
     oExcelWorkbook.Close False
     oExcelApp.Quit
       
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub

4. ComboBox3

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Option Explicit
Private Const sAdressDatei As String = _
     "adress.xlsx"
 
Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     If ComboBox3.ListIndex >= 0 Then
     
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
         lZeile = 2
         With oExcelWorkbook.sheets("signature")
             Do While .Cells(lZeile, 1) <> ""
                 If ComboBox3.Text = CStr(.Cells(lZeile, 2).Value) Then
                     ActiveDocument.Bookmarks("Textmarke_Unterschrift2").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
        
         oExcelWorkbook.Close False
         oExcelApp.Quit
          
         Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     
     End If
 
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub
 
Private Sub CommandButton2_Click()
     Unload Me
End Sub
 
 
Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
   
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
     
     ComboBox3.Clear
     lZeile = 2
     With oExcelWorkbook.sheets("signature")
         Do While .Cells(lZeile, 1) <> ""
             ComboBox3.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
        
     oExcelWorkbook.Close False
     oExcelApp.Quit
       
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub

Freue mich über jeden Tipp oder jede Lösung und bedanke mich schon einmal vielmals im Voraus

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Word Userform Excel-Abfragen zusammenfassen
 23.10.2015 20:20:19 xtoph
NotSolved