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
.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