✔ Alternative zu Excel und openoffice

[Tom_Green]

hey jungs danke viel mals für eure Unterstützung. Ich war nochmals ein bisschen tüchtig und war auf der Suche nach einem Macro für Word, welches mir bei Bookmarks die gewünschte Excel Tabelle, oder besser gesagt ein Teil eines Sheets einfühgt und ich wurde fündig.

Sub aUpdateWorddoc()

''==============================================================================
''Purpose: To refresh the current table in a Word document with new data from
'' the corresponding range in an Excel document.
''The code uses bookmarks in the Word document and corresponding named ranges in
'' Excel. The Excel data is brought in as pictures. This has the advantage that any
'' formatting in the Excel document is retained, and the dimensions don't change
'' significantly.
'' Also, bookmarks are simpler to create and maintain because a picture is only a
'' single character in a Word document.
''Requires: A table in the Excel file to line up the bookmarks and named ranges
''Created: 23 Oct 2008 by Denis Wright
''==============================================================================
    Dim objExcel As Object, _
        objWbk As Object, _
        objDoc As Document
    Dim sBookmark As String, _
        sWbkName As String
    Dim sRange As String, _
        sSheet As String
    Dim BMRange As Range
    Dim bmk As Bookmark
    Dim i As Integer, _
        j As Integer, _
        k As Integer, _
        bmkCount As Integer
    Dim vNames()
    Dim vBookmarks()
    Dim dlgOpen As FileDialog
    Dim bnExcel As Boolean
    
    On Error GoTo Err_Handle
    
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogOpen)
    bnExcel = False
    Do Until bnExcel = True
        With dlgOpen
            .AllowMultiSelect = True
            .Show
            If .SelectedItems.Count > 0 Then
                sWbkName = .SelectedItems(1)
            Else
                MsgBox "Please select a workbook to use for processing"
            End If
        End With
        If InStr(1, sWbkName, ".xls") > 0 Then
            'proceed
            bnExcel = True
        Else
            MsgBox "The file must be a valid Excel file. Try again please..."
        End If
    Loop
    
    Set objDoc = ActiveDocument
    
    'check to see that the Excel file is open. If not, open the file
    'also grab the wbk name to enable switching
    Set objExcel = GetObject(, "Excel.Application")
    
    For i = 1 To objExcel.Workbooks.Count
        If objExcel.Workbooks(i).Name = sWbkName Then
            Set objWbk = objExcel.Workbooks(i)
            Exit For
        End If
    Next
    
    If objWbk Is Nothing Then
        Set objWbk = objExcel.Workbooks.Open(sWbkName)
    End If
    
    'minimize the Excel window
    objExcel.WindowState = -4140 'minimized
    
    'switch to Excel, find range name that corresponds to the bookmark
    objExcel.Visible = False
    objWbk.Activate
    vNames = objWbk.Worksheets("Lists").Range("Bookmarks").Value
    
    'loop through the bookmarks
    bmkCount = ActiveDocument.Bookmarks.Count
    ReDim vBookmarks(bmkCount - 1)
    j = LBound(vBookmarks)
    For Each bmk In ActiveDocument.Bookmarks
        vBookmarks(j) = bmk.Name
        j = j + 1
    Next bmk
    
    For j = LBound(vBookmarks) To UBound(vBookmarks)
        'go to the bookmark
        Selection.GoTo What:=wdGoToBookmark, Name:=vBookmarks(j)
        Set BMRange = ActiveDocument.Bookmarks(vBookmarks(j)).Range
            
        For k = 1 To UBound(vNames)
            If vNames(k, 1) = vBookmarks(j) Then
                sSheet = vNames(k, 2)
                sRange = vNames(k, 3)
                Exit For
            End If
        Next k
            
        'copy data from the range as a picture
        objWbk.Worksheets(sSheet).Range(sRange).CopyPicture 1, -4147
        
        'return to Word and paste
        objDoc.Activate
        BMRange.Select
        Selection.Delete
        'Note: only required if the bookmark encloses a picture.
        'If the bmk held text, deleting the selection removes the bmk too.
        'Under those circumstances the code throws an error.
        'Clunky workaround: tell Word to ignore the error
        On Error Resume Next
        ActiveDocument.Bookmarks(sBookmark).Delete
        On Error GoTo 0
    
        'paste the picture, then move back one character so the new bookmark
        'encloses the pasted picture
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.Move Unit:=wdCharacter, Count:=-1
        
        'now reinstate the bookmark
        objDoc.Bookmarks.Add Name:=vBookmarks(j), Range:=Selection.Range
    
    Next j
    
Err_Exit:
    'clean up
    Set BMRange = Nothing
    Set objWbk = Nothing
    objExcel.Visible = True
    Set objExcel = Nothing
    Set objDoc = Nothing
    
    MsgBox "The document has been updated"
    
Err_Handle:
    If Err.Number = 429 Then 'excel not running; launch Excel
        Set objExcel = CreateObject("Excel.Application")
        Resume Next
    ElseIf Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description
        Resume Err_Exit
    End If
    

End Sub

Dieses Macro updated mir das Wordfile wie gewünscht. D. h. es setzt mir die Teilsheets als Picture in das Word doc ein. Somit habe ich eine wesentlich kürzere Ladezeit des Files und ich bin flexiebel mit der Location der Files.

Danke nochmals und vielleicht bis ein anderes mal.