Imports Microsoft.Office.Interop.Word Imports Microsoft.Toolkit.Uwp.Notifications Imports Model Public Class VBOffice Private WithEvents objWord As Microsoft.Office.Interop.Word.Application Private WithEvents docWord As Microsoft.Office.Interop.Word.Document Dim Cursor_Positionieren As Boolean = False Dim Dokumentdaten As New System.Data.DataTable Dim CreateDoc As Boolean Dim dg As Object Dim Progressvalue As Double Dim Progressbarvalue As Integer Public Sub Fill_Word(ByRef word As Microsoft.Office.Interop.Word.Application, ByRef docata As clsDocData, create As Boolean, dialoggenerate As Object, progessvalue As Double) objWord = word docWord = word.ActiveDocument dg = dialoggenerate Progressbarvalue = 30 Me.Progressvalue = progessvalue Me.CreateDoc = create objWord.WindowState = Microsoft.Office.Interop.Word.WdWindowState.wdWindowStateMinimize objWord.ScreenUpdating = False Dokumentdaten.Columns.Add("beginntextmarke") Dokumentdaten.Columns.Add("endetextmarke") Dokumentdaten.Columns.Add("used") Dokumentdaten.Columns.Add("aktiv") Dokumentdaten.Columns.Add("xvalue") Dokumentdaten.Columns.Add("feldname") For i As Integer = 0 To docata.DocValues.Count - 1 Dim dr As System.Data.DataRow = Dokumentdaten.NewRow dr(0) = docata.DocValues(i).TMBeginn dr(1) = docata.DocValues(i).TMEnd dr(2) = 1 dr(3) = 1 dr(4) = docata.DocValues(i).Value dr(5) = docata.DocValues(i).FieldName Dokumentdaten.Rows.Add(dr) Next Dokumentdaten.AcceptChanges() If docata.Kopfzeile_generieren = True Then Insert_Kopfzeile() Dokumentwerte_Uebertragen(False) word.ScreenUpdating = True End Sub Private Sub Insert_Kopfzeile() On Error Resume Next objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory) If objWord.ActiveWindow.View.SplitSpecial <> Microsoft.Office.Interop.Word.WdSpecialPane.wdPaneNone Then objWord.ActiveWindow.Panes.Item(2).Close() End If If objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdNormalView Or objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdOutlineView Then objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdPrintView End If objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekCurrentPageHeader set_headerbookmark() objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekMainDocument End Sub Private Sub set_headerbookmark() Try docWord.Bookmarks.Item("TGEDKCompanyBBEB99").Select() Catch objWord.Selection.MoveDown(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Count:=1) With objWord.ActiveDocument.Bookmarks .Add(Range:=objWord.Selection.Range, Name:="TGEDKCompanyBBEB99") .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With End Try End Sub Private Sub Dokumentwerte_Uebertragen(ByVal AusParametrisierung As Boolean) Dim i As Long Dim pos As Long Dim pos2 As Long Dim Fieldlen As Long For i = 0 To Dokumentdaten.Rows.Count - 1 dg.set_progress(Me.Progressbarvalue + (i * Progressvalue), Dokumentdaten.Rows(i).Item("beginntextmarke").ToString) '.add_progress(Progressvalue, Dokumentdaten.Rows(i).Item("beginntextmarke").ToString) 'Threading.Thread.CurrentThread.Sleep(400) 'Beginn-Textmarke If Dokumentdaten.Rows(i).Item("aktiv") = True Then If Dokumentdaten.Rows(i).Item("beginntextmarke") Is System.DBNull.Value Then Dokumentdaten.Rows(i).Item("beginntextmarke") = "" End If If Dokumentdaten.Rows(i).Item("endetextmarke") Is System.DBNull.Value Then Dokumentdaten.Rows(i).Item("endetextmarke") = "" End If If Dokumentdaten.Rows(i).Item("feldname") Is System.DBNull.Value Then Dokumentdaten.Rows(i).Item("feldname") = "" End If If Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKCursor" Or Dokumentdaten.Rows(i).Item("beginntextmarke") = "TGEDKCursorB" Or Dokumentdaten.Rows(i).Item("feldname") = "TGEDKCursorB" Or Dokumentdaten.Rows(i).Item("feldname") = "TGEDKCursor" Then Cursor_Positionieren = True Else If Dokumentdaten.Rows(i).Item("beginntextmarke") <> "" And Dokumentdaten.Rows(i).Item("endetextmarke") = "" Then Try docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Select() pos = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Start If AusParametrisierung Then objWord.Selection.Text = Dokumentdaten.Rows(i).Item("testdaten") Else If Dokumentdaten.Rows(i).Item("used") = 1 Then 'If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then ' If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "TGEDKDirektTelefonB" Or _ ' Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "TGEDKDirektTelefonZ" Then ' objword.Visible = True ' objword.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue") + " " ' Else objWord.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue") ' End If End If End If pos2 = objWord.Selection.End If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "XTGEDKDirektTelefonB" Or Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 23) = "XTGEDKVornameNameBetreue" Or Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 19) = "XTGEDKDirektTelefonZ" Then objWord.Selection.MoveLeft(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) 'hutter If Me.CreateDoc Then objWord.Selection.TypeText(Text:=" ") objWord.Selection.SetRange(Start:=pos + 1, End:=pos2 + 1) With docWord.Bookmarks .Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke")) .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With Else If Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 22) = "XTGEDKDirektTelefonDokZ" Or Microsoft.VisualBasic.Left(Dokumentdaten.Rows(i).Item("beginntextmarke"), 20) = "XTGEDKVornameNameDokZ" Then objWord.Selection.Text = Dokumentdaten.Rows(i).Item("xvalue") objWord.Selection.MoveLeft(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) objWord.Selection.TypeText(Text:=" ") objWord.Selection.SetRange(Start:=pos + 1, End:=pos2 + 1) With docWord.Bookmarks .Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke")) .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With Else objWord.Visible = True objWord.Selection.SetRange(Start:=pos, End:=pos2) With docWord.Bookmarks .Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke")) .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With End If End If objWord.Selection.MoveLeft(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) objWord.Selection.MoveLeft(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=2, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend) If objWord.Selection.Text = " " Then objWord.Selection.MoveRight(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) objWord.Selection.MoveLeft(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend) objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1) End If Catch End Try 'EDEX Banklagernd End If 'Beginn- und Ende-Textmarke If Dokumentdaten.Rows(i).Item("beginntextmarke") <> "" And Dokumentdaten.Rows(i).Item("endetextmarke") <> "" Then Try docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Select() pos = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("beginntextmarke")).Start docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("endetextmarke")).Select() pos2 = docWord.Bookmarks.Item(Dokumentdaten.Rows(i).Item("endetextmarke")).Start objWord.Selection.SetRange(Start:=pos, End:=pos2) If AusParametrisierung Then objWord.Selection.TypeText(Text:=Dokumentdaten.Rows(i).Item("testdaten")) Else If Dokumentdaten.Rows(i).Item("used") = 1 Then ' If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then objWord.Selection.TypeText(Text:=Dokumentdaten.Rows(i).Item("xvalue")) End If End If With docWord.Bookmarks .Add(Range:=objWord.Selection.Range, Name:=Dokumentdaten.Rows(i).Item("beginntextmarke")) .DefaultSorting = Microsoft.Office.Interop.Word.WdBookmarkSortBy.wdSortByName .ShowHidden = False End With Catch End Try End If 'Felder If Dokumentdaten.Rows(i).Item("feldname") <> "" Then Try 'contentcontrols If Dokumentdaten.Rows(i).Item("feldname").ToString.Substring(0, 3) = "cc_" Then objWord.ActiveDocument.SelectContentControlsByTag(Dokumentdaten.Rows(i).Item("feldname")).Item(1).Range.Text = Dokumentdaten.Rows(i).Item("xvalue") End If If docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width <> 0 Then Fieldlen = docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).TextInput.Width = Fieldlen + 5 End If If AusParametrisierung Then docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).Result = convert_wordfelder(Dokumentdaten.Rows(i).Item("testdaten")) Else If Dokumentdaten.Rows(i).Item("used") = 1 Then ' If Dokumentdaten.Rows(i).Item("xvalue") <> "" Then docWord.FormFields.Item(Dokumentdaten.Rows(i).Item("feldname")).Result = convert_wordfelder(Dokumentdaten.Rows(i).Item("xvalue")) End If End If Catch End Try End If End If End If Next End Sub Function convert_wordfelder(ByVal x As String) As String Dim s As String Dim s1 As String Dim i As Integer s = x i = InStr(s, Chr(13)) While i > 0 s = Left(s, i - 1) & "#" & Right(s, Len(s) - (i)) If Mid(s, i + 1, 1) = Chr(10) Then s = Left(s, i) & Right(s, Len(s) - (i + 1)) End If i = InStr(s, Chr(13)) End While i = InStr(s, "#") While i > 0 s = Left(s, i - 1) & Chr(11) & Right(s, Len(s) - (i)) i = InStr(s, "#") End While convert_wordfelder = s End Function End Class