Lopslag i excel skal overføres til word

Kunne man evt. lave en userform eller hvad det nu hedder i excel, som henter dataene ved et lopslag og sætter de ovenstående 4 linier ind i et word dokument og derefter lukker excel, så man er klar til at indtaste i word

Ja, det kan lade sig gøre således:
I word kan en userform vises. Heri indtastes kundenr og data kan hentes fra Excelfilen uden at denne åbnes.

Ja, det er lige sådan noget jeg leder efter.
Er det noget være mig behælpelig med?

Ja, vender tilbage.......

Enten kopier nedenstående kode - som anført - eller
send en mail til:pb@supertekst-it.dk - så returnerer jeg systemfilerne...

Kode i ThisDocument: (Word-dok Alt+F11)
Sub AutoOpen()
    Load UserForm1
    UserForm1.Show 0
End Sub

Kode i Userform:
Rem Reference til Microsoft Excel 5.0 Object Library er tilføjet (VBA (Alt+F11) - Tools/References)
Dim xls As Object, xSti, kundeData As String
Private Sub CommandButton1_Click()                  'OK - indsæt data
    With ActiveDocument
        WordBasic.Insert kundeData
    End With
   
    Me.CommandButton1.Visible = False
    Me.Label2 = ""
    Me.TextBox1 = ""
End Sub
Private Sub CommandButton2_Click()                  'Annuller - userform lukkes
    Unload UserForm1
End Sub
Private Sub TextBox1_Change()
    If Me.TextBox1.Value <> "" And IsNumeric(Me.TextBox1.Value) = True Then
        kundeData = hentKundedata(Val(Me.TextBox1))
        If kundeData <> "" Then
            Label2.Caption = kundeData
            Me.CommandButton1.Visible = True
        Else
            Me.Label2.Caption = "Kundedata ej fundet"
        End If
    End If
End Sub
Private Sub UserForm_activate()
    hentSti
    Me.CommandButton1.Visible = False
End Sub
Private Sub hentSti()
    xSti = ActiveDocument.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Private Function hentKundedata(kundeNr)
Dim antalRæk, r, aData As String

    aData = ""
    Set xls = CreateObject("Excel.application")
    With xls
        .workbooks.Open (xSti + "kunder.xls")
        .sheets(1).Activate
        antalRæk = .activecell.specialcells(xllastcell).Row
        For r = 1 To antalRæk
            If .Cells(r, 1) = kundeNr Then
Rem I Excel ark1> Kol 1: Nr / 2: Navn / 3: Adresse1 / 4: Adresse2 / 5: PostNr By
Rem ============================================================================
              aData = aData + .Cells(r, 2) + vbCr + _
                .Cells(r, 3) + vbCr + _
                    .Cells(r, 4) + vbCr + _
                        .Cells(r, 5)
                hentKundedata = aData
                xls.Application.Quit
                Set xls = Nothing
                Exit Function
            End If
        Next r
    End With
   
    xls.Application.Quit
    Set xls = Nothing
    hentKundedata = ""
End Function

mail sendt :-)

Har sendt 2 mails til dig - men de kommer retur??

Har modtaget din fil - vil se på den i eftermiddag

mail sendt

Du får et svar for "første halvleg"

Tusind tak for hjælpen :o)

Tilgår der lidt senere. Eller stopper vi her?

We are going on...

Har sendt Momsseddel til dig i går på din "anden mail" - den første virker stadig ikke - forsendelser hertil returneres.
Læg besked her, hvis du ikke har modtaget det fremsendte.