Tabelle in Writer mit Werten aus Access füllen

Antwort erstellen

BBCode ist eingeschaltet
[img] ist ausgeschaltet
[url] ist eingeschaltet
Smileys sind ausgeschaltet
Die letzten Beiträge des Themas
   

Ansicht erweitern Die letzten Beiträge des Themas: Tabelle in Writer mit Werten aus Access füllen

Tabelle in Writer mit Werten aus Access füllen

von Murphy1170 » Fr, 14.11.2008 18:37

Hallo,
ich versuche schon den ganzen Tag in der Hilfe, Suche usw. Daten über Writer und API zubekommen.
Irgendwie trete ich auf der Stelle.
Vielleicht hat jemand eine Idee. Folgender Code verwende ich in Access zur Übergabe an MS Word.

Code: Alles auswählen

Option Compare Database
Option Explicit

Private objWord As Object 'Word.Application
Private objWordDoc As Object ' Word.Document
Private objRange As Object 'Word.Range

Private lngSizeToPageBreak As Long
Private intHardBreaksNewPage As Integer

Private Const WORD_INITSTRING = "Word.Application"
Private Const TWIPS = 567       'Ein Zentimeter = 567 twips
'-----------------------------------------------------------------------------

Public Function SetWordBookmark(strBookmark As String, _
                                strText As String, _
                                Optional bInsert As Boolean = False, _
                                Optional lngStartPosition As Long = 0) As Long
Dim objWordBookmark As Object 'Word.Bookmark
Dim objWordRange As Object 'Word.Range
Dim intLength As Integer
  
  On Error Resume Next
  
  Set objWordBookmark = CreateObject("Word.Bookmark")
  Set objWordRange = CreateObject("Word.Range")

    intLength = Len(strText)
    If bInsert Then
        If Not objWordDoc.Bookmarks.Exists(strBookmark) Then
            Set objWordRange = objWordDoc.Range(lngStartPosition, lngStartPosition)
            objWordDoc.Bookmarks.Add strBookmark, objWordRange
        End If
    End If
    If objWordDoc.Bookmarks.Exists(strBookmark) Then
        Set objWordBookmark = objWordDoc.Bookmarks(strBookmark)
        objWordBookmark.End = objWordBookmark.Start
        objWordBookmark.Range.Text = strText
        objWordBookmark.End = objWordBookmark.Start + intLength
        SetWordBookmark = objWordBookmark.End
        objRange.Start = objWordBookmark.End
        objRange.End = objRange.Start
    Else
        SetWordBookmark = lngStartPosition
    End If
    TestAndInsertPageBreak
End Function
'---------------------------------------------------------------------------------------
'Öffnet ein Dokument oder erstellt ein neues Dokument aufgrund einer Vorlage
Public Function OpenDoc(strDocument As String, bIsTemplate As Boolean) As Object 'Word.Document
    On Error GoTo proc_err
    If bIsTemplate Then
        Set objWordDoc = objWord.Documents.Add(Template:=strDocument)
    Else
        'Set objWordDoc = objWord.Documents.Open(strDocument, , , False)
        Set objWordDoc = objWord.Documents.Open(strDocument)
    End If
    'Set objRange = objWord.ActiveDocument.Range
    'objRange.Start = 1
    'objRange.End = objRange.Start
    Set OpenDoc = objWordDoc
proc_exit:
  Exit Function
proc_err:
  MsgBox "Fehler beim Öffnen des Word Dokumentes (" & Err.Number & "). " & vbCrLf & Err.description
  Resume proc_exit

End Function
'----------------------------------------------------------------------------------
Public Sub OpenDocSimple(strDok As String)
  On Error Resume Next
  objWord.Documents.Open strDok
  objWord.Visible = True
  objWord.WindowState = 1
  objWord.Activate
End Sub
'----------------------------------------------------------------------------------
Public Sub Show()
    On Error Resume Next
    objWordDoc.Windows(1).View.ShowBookmarks = False
    objWord.Visible = True
    objWord.WindowState = 1
    objWord.Activate
End Sub
'----------------------------------------------------------------------------------
Public Sub CloseAll()
    On Error Resume Next
    objWordDoc.close True
    objWord.Quit True
End Sub
'----------------------------------------------------------------------------------
Public Sub Insert(strText As String)
    On Error Resume Next
    objRange.Text = strText
    objRange.Start = objRange.End
    TestAndInsertPageBreak
End Sub
'----------------------------------------------------------------------------------
Public Sub InsertSpace(Optional count As Integer = 1)
Dim intCount As Integer
    On Error Resume Next
    If count > 0 Then
        For intCount = 1 To count
            Me.Insert " "
        Next intCount
    End If
End Sub
'----------------------------------------------------------------------------------
Public Sub InsertSoftBreak(Optional count As Integer = 1)
Dim intCount As Integer
    On Error Resume Next
    If count > 0 Then
        For intCount = 1 To count
            objRange.Collapse
            objRange.InsertBreak 6
            objRange.Start = objRange.End
        Next intCount
        TestAndInsertPageBreak
    End If
End Sub
'----------------------------------------------------------------------------------
Public Sub InsertHardBreak(Optional count As Integer = 1)
Dim intCount As Integer
    On Error Resume Next
    If count > 0 Then
        For intCount = 1 To count
            Me.Insert vbCrLf
        Next intCount
        TestAndInsertPageBreak
    End If
End Sub
'----------------------------------------------------------------------------------
Public Property Get aktPosition() As Long
    On Error Resume Next
    aktPosition = objRange.End
End Property
'----------------------------------------------------------------------------------
Public Property Get ParagraphFormat() As String
    On Error Resume Next
    ParagraphFormat = objRange.ParagraphFormat.Style
End Property
'----------------------------------------------------------------------------------
Public Property Let ParagraphFormat(strName As String)
    On Error Resume Next
    objRange.ParagraphFormat.Style = strName
End Property
'----------------------------------------------------------------------------------
Public Property Let SizeToPageBreak(PercentSize As Long)
    'Ermittelt die Länge in mm, ab der ein Seitenumbruch stattfinden soll
      On Error Resume Next
     lngSizeToPageBreak = ((objWordDoc.PageSetup.PageHeight * 20) / (TWIPS / 10)) * (PercentSize / 100)
End Property
'----------------------------------------------------------------------------------
Private Sub Class_Initialize()
    'Initialisieren des Word-Objectes
    On Error Resume Next
        Set objWord = GetObject(, WORD_INITSTRING)
        If Err Then
             Set objWord = CreateObject(WORD_INITSTRING)
             Err.Number = 0
        End If
    On Error GoTo 0
End Sub
'----------------------------------------------------------------------------------
Private Sub Class_Terminate()
    On Error Resume Next
    Set objRange = Nothing
    Set objWordDoc = Nothing
    Set objWord = Nothing
End Sub
'----------------------------------------------------------------------------------
'Testet den Abstand zum unteren Seitenrand und
'fügt einen Seitenumbruch ein
Private Sub TestAndInsertPageBreak()
Dim lngAktPosition As Long
Dim strParagraphFormat As String
On Error Resume Next
objRange.Select
lngAktPosition = (objWord.Selection.Information(6) * 0.353)
    If lngSizeToPageBreak > 0 Then
        If lngAktPosition > lngSizeToPageBreak Then
            'Zwischenspeichern des Absatzformates
            strParagraphFormat = Me.ParagraphFormat
            objRange.Collapse
            objRange.InsertBreak 7
            objRange.Start = objRange.End
            Me.InsertHardBreak intHardBreaksNewPage
            Me.ParagraphFormat = strParagraphFormat
        End If
    End If
End Sub
'----------------------------------------------------------------------------------
Public Property Let HardBreaksNewPage(intCount As Integer)
  On Error Resume Next
    intHardBreaksNewPage = intCount
End Property
Mich würde interessieren wo ich z.B. die Werte von Writer herbekomme wie z.b:
.CreateObject("Word.Bookmark")
.Range
.ParagraphFormat.Style
.Collapse
.InsertBreak 6 usw.

Hat jemand einen Rat? Oder hat jemand Bibliotheken für den Writer/API ? im Weltweiten WWW habe ich bisher noch nicht wirklich was
brauchbares gefunden :-(

Vielen Dank

Murphy1170

Nach oben