You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

262 lines
14 KiB

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