Tipp 0039 Texte an Word-Textmarken übergeben
Autor/Einsender:
Datum:
  Angie
28.01.2005 (Update)
Entwicklungsumgebung:   VB 5/VBA 5
Eine Textmarke markiert eine Textstelle oder Textpassage in einem Word-Dokument, die beispielsweise zum späteren Nachschlagen festgelegt und benannt wird, oder aber auch um damit per VB/VBA einer bestimmten Stelle Text zuzuweisen. Für diesen Tipp wurde vorweg bereits eine Word-Dokumentvorlage (*.dot) mit den entsprechenden Textmarken erstellt. Auf Basis dieser Dokumentvorlage wird per VB ein neues Dokument (*.doc) erstellt, und dann der in den TextBoxen eingegebene Text den Textmarken in Kopf- und Fusszeile und im Hauptteil des Dokuments zugewiesen.
 
Option Explicit
 
Private Const mc_DocTemplate As String = "Beispiel.dot"
Private Const mc_AppMsgTitle As String = _
                    "Text an Word-Textmarken übergeben"
 
Private m_strTemplateFile As String
 
Private m_objWDApp  As Word.Application
Private m_objWDDoc  As Word.Document
 
Private Sub Form_Load()
  Dim strPath As String
 
  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
 
  m_strTemplateFile = strPath & mc_DocTemplate
End Sub
 
Private Sub cmdCreateNewDoc_Click()

  If TypeName(m_objWDApp) <> "Application" Then
    On Error Resume Next
    Set m_objWDApp = Nothing
 
    Set m_objWDApp = CreateObject("Word.Application")
    If Err.Number <> 0 Then
      MsgBox "Konnte keine Verbindung zu Word herstellen !", _
             vbOKOnly + vbCritical, mc_AppMsgTitle
    End If
    On Error GoTo 0
  End If
 
  If TypeName(m_objWDApp) = "Application" Then
    m_objWDApp.Application.Visible = True
 
    If TypeName(m_objWDDoc) <> "Document" Then
      On Error Resume Next
      Set m_objWDDoc = Nothing
 
      Set m_objWDDoc = m_objWDApp.Documents.Add( _
           Template:=m_strTemplateFile, NewTemplate:=False)
 
      If Err.Number = 0 Then
        With m_objWDDoc.ActiveWindow
          .View.Type = wdPageView
          .ActivePane.View.Zoom.PageFit = wdPageFitBestFit
        End With
 
        m_objWDApp.Application.Activate
 
      Else
        MsgBox "Es konnte kein neues Dokument auf " & _
               "der Basis Dokumentvorlage '" & _
               mc_DocTemplate & "' erstellt werden!", _
               vbOKOnly + vbCritical, mc_AppMsgTitle
      End If
      On Error GoTo 0
    End If
 
    If TypeName(m_objWDDoc) = "Document" Then
      AddTextToBookmarks "tmKopfzeile", Text1.Text
      AddTextToBookmarks "tmDoc", Text2.Text
      AddTextToBookmarks "tmFusszeile", Text3.Text
    End If
  End If
End Sub
 
Private Sub AddTextToBookmarks(ByVal strBMName As String, _
      ByVal strBMText As String)
 
  Dim objBMRange As Word.Range
 
  With m_objWDDoc
    If .Bookmarks.Exists(strBMName) Then
      Set objBMRange = .Bookmarks(strBMName).Range
      objBMRange.Text = strBMText
      .Bookmarks.Add Name:=strBMName, Range:=objBMRange
      Set objBMRange = Nothing
    End If
  End With
End Sub
 
Private Sub cmdQuit_Click()
  Unload Me
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, _
      UnloadMode As Integer)
 
  On Error Resume Next
 
  If TypeName(m_objWDDoc) = "Document" Then
    m_objWDDoc.Close SaveChanges:=wdDoNotSaveChanges
  End If
  Set m_objWDDoc = Nothing
 
  If TypeName(m_objWDApp) = "Application" Then
    m_objWDApp.Application.Quit
  End If
  Set m_objWDApp = Nothing
 
  On Error GoTo 0
End Sub
 
Weitere Links zum Thema
Word-Textmarken und ihr Verhalten
Automation mit Office-Anwendungen
Word-Automatisierungsfehler vermeiden
Hinweis für VBA-Anwender
Im Download befindet sich auch ein Excel/VBA-Beispiel.
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft Word x.0 Object Library in das VB-/VBA-Projekt eingebunden werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (35,8 kB) Downloads bisher: [ 3896 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 28. August 2011