Keine Ahnung warum ein Dropdown, ist halt deine Masche
Das Element aktualisierst du dann eben so
Sub Versorge()
'
' Beispiel Makro - Angaben zur Suche in den Konstanten so variabel als möglich
'
Const Adressenpfad As String = "E:\WordVBA\Beispiel.xlsx"
Const sTablename As String = "Tabelle1$"
Const Spalte As Long = 1 'A
Const Zeile As Long = 2 '= 3 da bei 0
'
Dim arr()
'
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim oCC As Word.ContentControl
Dim x As Long
sSQL = "SELECT * FROM " & Chr(91) & sTablename & Chr(93)
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
With oConn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & Adressenpfad & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"""
.Open
End With
oRS.Open sSQL, oConn ', 3, 1, 1
If Not oRS.EOF Then
arr = oRS.GetRows
End If
With ActiveDocument
Set oCC = .ContentControls(1)
With oCC
.DropdownListEntries.Clear
For x = LBound(arr, 2) + Zeile To UBound(arr, 2)
.DropdownListEntries.Add arr(Spalte - 1, x)
Next x
End With
End With
Set oConn = Nothing
Set oRS = Nothing
End Sub
Die Auswahl in die Zwischenablage dann so
Sub ViaDrop()
'
' Beispiel Makro - Angaben zur Suche in den Konstanten so variabel als möglich
'
Const Adressenpfad As String = "E:\WordVBA\Beispiel.xlsx"
Const sTablename As String = "Tabelle1$"
Const Spalte As Long = 1
'
Dim strInput As Variant
'
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim sField As String
Dim sFilter As String
'
Dim oData As New DataObject
Dim sText As String
'
Dim oCC As Word.ContentControl
Dim x As Long
With ActiveDocument
Set oCC = .ContentControls(1)
With oCC
strInput = .Range.Text
End With
End With
sSQL = "SELECT * FROM " & Chr(91) & sTablename & Chr(93)
Set oConn = CreateObject("ADODB.Connection")
Set oRS = CreateObject("ADODB.Recordset")
With oConn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & Adressenpfad & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"""
.Open
End With
oRS.Open sSQL, oConn ', 3, 1, 1
If Not oRS.EOF Then
sField = "F" & Format(Spalte, "#")
sFilter = sField & " = " & Chr(39) & strInput & Chr(39)
oRS.Filter = sFilter
If Not oRS.EOF Then
sText = oRS.Fields(0) & vbLf & oRS.Fields(1) & vbLf & oRS.Fields(2)
With oData
.SetText sText
.PutInClipboard
End With
MsgBox "Zwischenablage gefüllt"
Else
MsgBox strInput & vbLf & "nicht erkannt"
End If
End If
Set oConn = Nothing
Set oRS = Nothing
Set oData = Nothing
Set oCC = Nothing
End Sub
|