Indsættelse af tekset fra Excel til word bogmærker

Indsæt din bogmærker i word.
Her er et eksempel på overførsel fra excel til word ved bogmærker.
Bemærk at du i ´vba editoren skal have referencer til msword.
Denne overfører a1,b1,c1,d1 og e1 til de respektive bogmærker.

Private Sub MergeButton_Click()
      On Error GoTo MergeButton_Err
        Dim objWord As Word.Application
        Set objWord = CreateObject("Word.Application")
        With objWord
           
            .Visible = True
            .Documents.Open ("c:\minfil.doc")
            ' Move to each bookmark and insert text from the form.
            .ActiveDocument.Bookmarks("Fornavn").Select
            .Selection.Text = Range("a1")
            .ActiveDocument.Bookmarks("efternavn").Select
            .Selection.Text = Range("b1")
            .ActiveDocument.Bookmarks("adresse").Select
            .Selection.Text = Range("c1")
            .ActiveDocument.Bookmarks("by").Select
            .Selection.Text = Range("d1")
            .ActiveDocument.Bookmarks("postnummer").Select
            .Selection.Text = Range("e1")
        End With
        objWord.ActiveDocument.Close
        objWord.Quit
        Set objWord = Nothing
        Exit Sub
MergeButton_Err:
        If Err.Number = 94 Then
            objWord.Selection.Text = ""
            Resume Next
        Else
            MsgBox Err.Number & vbCr & Err.Description
        End If
        Exit Sub
      End Sub

Du skal nok lige i første omgang remme  disse linier ud
objWord.ActiveDocument.Close
        objWord.Quit
        Set objWord = Nothing

Hej Bak
Nu har jeg prøvet, men det virker ikke helt, vil du ikke være så venlig at sende mig en excel fil og en word fil, hvor det virker...

Joda, email ?

hh@post4.netmaster.dk

Sendt

Private mobjWordApp As Word.Application
Private mobjWordDoc As Word.Document

Public Sub CopyToWord()
    Dim wks As Worksheet
    Dim rCell As Range
    Dim sProductLine As String
    Application.ScreenUpdating = False

    On Error GoTo ShitHappens
   
    'Starter word
    Set mobjWordApp = GetObject(, "Word.Application")
    With mobjWordApp
        .Visible = True
        Set mobjWordDoc = .Documents.Open(Filename:="C:\Temp\Eks 289951.doc")
    End With

    For Each wks In ActiveWorkbook.Worksheets
        For Each rCell In wks.Range("A1").CurrentRegion.Columns(1).Cells
            With rCell
                If UCase(rCell.Value) = "X" Then
                    Select Case wks.Name
                        Case "Names"
                            SetBookmarkAgain "SO_Compagny", .Offset(0, 1).Value
                            SetBookmarkAgain "SO_Address", .Offset(0, 2).Value
                            SetBookmarkAgain "SO_ZipCity", .Offset(0, 3).Value
                        Case "Remarks"
                            SetBookmarkAgain "SO_Remarks", .Offset(0, 1).Value
                        Case "Products"
                            sProductLine = sProductLine & .Offset(0, 1).Value & vbTab & .Offset(0, 2).Value & vbCrLf
                    End Select
                End If
            End With
        Next rCell
    Next wks
   
    If Not (sProductLine = "") Then
        SetBookmarkAgain "SO_ProductLines", sProductLine
    End If
   
    GoTo CleanUp
   
ShitHappens:
  Select Case Err.Number
    Case 429
      'Hvis Excel ikke er startet
      Set mobjWordApp = CreateObject("Word.Application")
      'Fortsætter programmet fra næste linie.
      Resume Next
    Case Else
      'Err.Raise Err.Number
  End Select
 
CleanUp:
'    Set mobjWordApp = Nothing
'    Set mobjWordDoc = Nothing
'    Set wks = Nothing
'    Set rCell = Nothing
    Application.ScreenUpdating = True
End Sub


Private Sub SetBookmarkAgain(ByRef sName As String, ByRef sContents As String)
    Dim rBookmark As Word.Range
    If mobjWordDoc.Bookmarks.Exists(sName) Then
        Set rBookmark = mobjWordDoc.Bookmarks(sName).Range
        rBookmark.Text = sContents
        rBookmark.Bookmarks.Add sName
    End If
End Sub

Også sendt på mail.

Det skal jo være formateret ordenligt - så lige en ændring:
Case "Products"
    sProductLine = sProductLine & .Offset(0, 1).Value & vbTab & _
    Format(.Offset(0, 2).Value, "#,###.00") & vbCrLf

Eksemplen mailes gerne - fd@win-consult.com