If .Tag = 1 Then 'OK button pressed

Sub ShowMyForm()
Dim oFrm As UserForm1
Dim i As Integer
Dim strWorkbook As String
    'the workbook path and name
    strWorkbook = "C:\Users\censored\Desktop\Testen\Tabellemitprozesse.xlsx"
    'Give the userform a name the macro will use
    Set oFrm = New UserForm1
    With oFrm
        'Call the function to fill the listbox with the workbook sheet 1 column 1
        xlFillList .ListBox1, 1, strWorkbook, "Tabelle1", True, True
        With .ListBox1
            .MultiSelect = fmMultiSelectExtended
            .ListIndex = -1
        End With
        .Show
        If .Tag = 1 Then 'OK button pressed
            FillBM "BM1", .ListBox1.Text 'Fill bookmark BM1 with the text box content
            With .ListBox1
                'locate the selected item from the list box and enter it in bookmark BM1
                For i = 1 To .ListCount - 1
                    If .Selected(i) = True Then
                        FillBM "BM1", .List(i)
                        Exit For
                    End If
                Next i
            End With
        End If
    End With
    Unload oFrm
End Sub

Public Sub FillBM(strBMName As String, strValue As String)
Dim oRng As Range
    With ActiveDocument
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strBMName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strBMName
    End With
lbl_Exit:
    Exit Sub
End Sub

Public Function xlFillList(ListOrComboBox As Object, _
                           iColumn As Long, _
                           strWorkbook As String, _
                           strRange As String, _
                           RangeIsWorksheet As Boolean, _
                           RangeIncludesHeaderRow As Boolean, _
                           Optional PromptText As String = "[Select Item]")

'Graham Mayor - http://www.gmayor.com - Last updated - 20 Sep 2018
'ListOrComboBox is the name of the list or combo box to be filled
'iColumn is the column in the sheet (or the range) to be displayed in the list/combo box
'strWorkbook is the full path of the workbook containing the data
'strRange is the name of the worksheet or named range containing the data
'RangeIsWorksheet - set to True if the range 'strRange' is a worksheet
' or False if it is a named range
'RangeIncludesHeaderRow - Set to True is the Worksheet or named range contains a header row
'PromptText - Use a text string here to add your preferred prompt text to a combobox.
'The PromptText is not used for ListBoxes.

Dim RS As Object
Dim CN As Object
Dim numrecs As Long, q As Long
Dim strWidth As String

    If RangeIsWorksheet = True Then
        strRange = strRange & "$]"
    Else
        strRange = strRange & "]"
    End If

    Set CN = CreateObject("ADODB.Connection")


    If RangeIncludesHeaderRow Then
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    Else
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""
    End If


    Set RS = CreateObject("ADODB.Recordset")
    RS.CursorLocation = 3

    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1    'read the data from the worksheet

    With RS
        .MoveLast
        numrecs = .RecordCount
        .MoveFirst
    End With

    With ListOrComboBox
        .ColumnCount = RS.Fields.Count
        If RS.RecordCount > 0 Then
            .Column = RS.GetRows(numrecs)
        End If

        strWidth = vbNullString
        For q = 1 To .ColumnCount
            If q = iColumn Then
                If strWidth = vbNullString Then
                    strWidth = .Width - 4 & " pt"
                Else
                    strWidth = strWidth & .Width - 4 & " pt"
                End If
            Else
                strWidth = strWidth & "0 pt"
            End If
            If q < .ColumnCount Then
                strWidth = strWidth & ";"
            End If
        Next q
        .ColumnWidths = strWidth
        If TypeName(ListOrComboBox) = "ComboBox" Then
            .AddItem PromptText, 0
            If Not iColumn - 1 = 0 Then .Column(iColumn - 1, 0) = PromptText
            .ListIndex = 0
        End If
    End With
lbl_Exit:
    'Cleanup
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
    Exit Function
End Function