vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: OLE/Registry/DLL · Automation   |   VB-Versionen: VB2008, VB2010, VB201219.02.15
Export von Daten mittels VB nach OpenOffice in Beleg/Formular

Im Tipp wird eine Funktion gezeigt, mit der VB-Daten (bspw. aus SQL-Datenbank) nach OpenOffice übertragen werden, sodass sie dort als Beleg/Formular dargestellt werden.

Autor:   Dietrich HerrmannBewertung:  Views:  7.815 
ohne HomepageSystem:  Win7, Win8, Win10, Win11kein Beispielprojekt 

Als erstes verweise ich auf meinen Tipp  Export von VB-Daten nach OpenOffice. Da werden die Grundlagen für die genannte Programmierung erläutert. Und ich beschreibe in einem Absatz die grundsätzliche Vorgehensweise. Daran änderte ich nichts. Es werden Beleg/Formularvorlagen in einem Verzeichnis erstellt und ein Verzeichnis für die zu erzeugenden ausgefüllten Belege/Formulare angelegt.

Allerdings unterscheidet sich die Verarbeitung der Daten entscheidend. Der Funktion wird immer nur ein Datensatz aus einer Datentabelle übergeben, dessen Daten dann 'positionsgerecht' in die vordefinierte OO-Tabelle (Calc oder Writer möglich) eingetragen werden. Dazu muss aber der Funktion 'mitgeteilt' werden, in welche Zelle der OO-Tabelle welche Information gespeichert werden soll. Zu beachten ist, wenn man Beleg/Formular in Writer definiert, muss die entsprechende Tabelle benannt werden, und wird der Funktion als Parameter 'repName' übergeben!

Dazu sind folgende Parameter vor dem Aufruf der Funktion zu definieren:

  • Datentabelle: myDataTable
  • DataRow: myDar
  • Name der Tabelle in Calc/Writer-Dokument: myBeleg
  • Feld der Datenfelder: myDataFields
  • Feld der Beleg/Formularadressen: myAdresses

Dann noch die Parameter für: Belegvorlagenpfad, Belegvorlagenname, Ausgabepfad, Name der Ausgabedatei usw., so wie auch im Vorgängertipp angegeben.

Beispiele für myDataFields korrespondierend mit myAdresses:

Dim myDataFields() As String = {"Identnummer;;0000 00000;l", "PlzOrt", "Str", "Name", "Telefon"}

Es werden 5 Datenfelder übergeben. Es ist möglich, zu einem Datenfeld noch einen 'Parameterstring' anzugeben. Dieser String kann folgenden Aufbau haben (einzelne Parameter durch ; getrennt)

  • Name des Datenfelds;Datenfeldtyp;Formatierungsstring;Alignmentstring
  • Name des Datenfelds - trivial
  • Datenfeldtyp - Decimal oder Int32 sind angebbar, Text ist Standard
  • Formatierungsstring - der von 'Formatfunktion' bekannte String
  • Alignmentstring - für die Ausrichtung der Daten in den Beleg/Formularzellen; r für rechts, l für links
Dim myAdresses() As String = {"C2", "C3", "E3", "B4", "F4"}

Definiert, dass die Daten in die angegebenen Zellen der Beleg/Formulartabelle eingetragen werden.
Also:
Identnummer in C2 (mit Format '0000 000000' und linksbündig)
PlzOrt in C3
Str in E3
Name in B4
Telefon in F4

Der Aufruf der Funktion erfolgt dann mit:

writeOOSpecialReportsToWriter(myDataTable, myDar, myBeleg, myDataFields, myAdresses, _
  myLayouts, firstLayoutTable, _
  myOutputs, firstOutputTable, ".ods")

mit:

  • myDGV: "expData"
  • myLayouts: "C:\Belegvorlagen"
  • firstLayoutTable: "personalDataBV.ods"
  • myOutputs: "C:\OO-Outputs"
  • firstOutputTable: "personalDataCalc.ods"

Hier nun die Funktion selbst:

''' <summary>
''' OpenOffice-SpecialReports/Formulare exportieren
''' </summary>
''' <param name="dTbl">Datatable</param>
''' <param name="dRow">Datenzeile der Datatable</param>
''' <param name="repName">Name des Reports</param>
''' <param name="felder">Felder für den Export</param>
''' <param name="aFeld">Feld der Adressen der Ausgabetabelle</param>
''' <param name="pfad">Pfad Belegvorlage</param>
''' <param name="fName">Name Belegvorlage</param>
''' <param name="ausgPfad">Ausgabepfad</param>
''' <param name="ausgName">Name Ausgabedatei</param>
''' <param name="hideFlag">OO verbergen oder nicht</param>
''' <param name="dialFlag">mit Speichern-Dialog oder nicht</param>
Public Sub writeOOSpecialReportsToWriter(dTbl As DataTable, dRow As DataRow, _
  repName As String, _
  felder() As String, aFeld() As String, _
  pfad As String, fName As String, _
  ausgPfad As String, ausgName As String, _
  Optional einExt As String = ".odt", _
  Optional hideFlag As Boolean = False, Optional dialFlag As Boolean = False)
 
  ' Hauptobjekt fuer den Zugriff auf OpenOffice von VB.Net aus (SM: ServiceManager)
  Dim oSM As Object
 
  ' Objekte von der OpenOffice-Schnittstelle (API)
  Dim oDesk, oDoc, oCell, oRows, oCols, oTables, oTable, oTable2, oSheet As Object
  Dim dispatcher, oBorderLine As Object
  Dim NumberFormats As Object
  Dim LocalSettings As Object
  Dim StyleFamilies As Object
 
  Try
    ' OpenOffice instanziieren: Zwingend notwenig fuer die Kommunikation 
    ' von VB.Net mit der OpenOffice API
    oSM = CreateObject("com.sun.star.ServiceManager")
 
    ' Erstelle den ersten und wichtigsten Dienst
    oDesk = oSM.createInstance("com.sun.star.frame.Desktop")  
 
    dispatcher = oSM.createInstance("com.sun.star.frame.DispatchHelper")
    oBorderLine = oSM.createinstance("com.sun.star.style.table.BorderLine")
    If einExt = ".odt" Then
      oTables = oSM.createInstance("com.sun.star.text.TextTables")
      oTable = oSM.createInstance("com.sun.star.text.TextTable")
      oTable2 = oSM.createInstance("com.sun.star.text.TextTable")
    End If
  Catch ex As Exception
    MessageBox.Show(ex.Message, "FEHLER OpenOffice", MessageBoxButtons.OK, MessageBoxIcon.Warning)
    Clipboard.SetText(ex.Message)
    Exit Sub
  End Try
 
  ' Um Writer/Calc im Hintergrund zu halten
  Dim ladeZustand(0)
  ladeZustand(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  ladeZustand(0).Name = "Hidden"
  ladeZustand(0).Value = hideFlag
 
  ' Erstelle eine neue Writer/Calc-Tabelle aus Belegvorlage
  Dim str As String = pfad + fName + einExt
  str = str.Replace("\", "/")
  str = "file:///" + str.Replace(":", "|")
  Try
    oDoc = oDesk.loadComponentFromURL(str, "_blank", 0, ladeZustand)
  Catch ex As Exception
    Dim t As String
    t = ex.Message + vbCrLf + ex.StackTrace + vbCrLf + vbCrLf + str
    MessageBox.Show(t, "FEHLER", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Exit Sub
  End Try
  StyleFamilies = oDoc.StyleFamilies
  Dim oParagraphStyles As Object
  If einExt = ".odt" Then oParagraphStyles = StyleFamilies.getByName("ParagraphStyles")
  ' Formatierung vorbereiten
  NumberFormats = oDoc.NumberFormats
 
  If einExt = ".odt" Then    ' die Tabelle in Writer ermitteln
    oTables = oDoc.getTextTables
    oTable = oTables.getByName(repName)
  Else  'Tabelle in Calc
    oSheet = oDoc.getSheets().getByIndex(0)    ' Tabelle in Calc: 1.Blatt der Mappe
    oTable = oSheet
  End If
 
  Dim anzCols, anzRows, feldLen As Integer, feld(), typN, zName, aktF As String
  Dim typ, i, z, pos(), p2 As Short
  Dim value As Object
  Dim typFeld() As String = Split(getTheFieldsString(dTbl, 1), ",")
  Dim namFeld() As String = Split(getTheFieldsString(dTbl, 3), ",")
 
  anzCols = dTbl.Columns.Count
  anzRows = dTbl.Rows.Count
  oRows = oTable.getRows()
  oCols = oTable.getColumns()
 
  For j As Short = 0 To felder.Length - 1
    feld = Split(felder(j), ";")
    feldLen = feld.Length
    typN = typFeld(namFeld.IndexOf(namFeld, feld(0))).Replace("System.", "")
    If typN = "Decimal" OrElse typN = "Int32" Then typ = 1 Else typ = 0
    If feldLen > 3 Then
      If feld(3) = "r" Then
        typ = 1   'align right
      ElseIf feld(3) = "l" Then
        typ = 0   'align left
      End If
    End If
    ' Datenzellen
    value = dRow.Item(feld(0))
    aktF = aFeld(j)
    p2 = aFeld(j).IndexOf(":")
    If p2 >= 0 Then ' zweite Tabelle angesprochen
      zName = aFeld(j).Substring(0, p2)
      oTable = oTables.getByName(zName)
      aktF = aFeld(j).Substring(p2 + 1)
    End If
    pos = convRangeToInt(aktF)
    z = pos(0) : i = pos(1)
    oCell = oTable.getCellByPosition(z, i)  ' Zelle für den Eintrag ermitteln
    If typ = 1 Then
      If Not IsDBNull(value) Then
        oCell.value = value
        ' align right
        If typ = 1 And einExt = ".odt" Then setCellAlignMarginText(oTable, oCell, typ, 200)
      Else
        oCell.String = ""
      End If
    Else
      oCell.string = value.ToString
      ' align left
      If einExt = ".odt" Then setCellAlignMarginText(oTable, oCell, typ, 200)
    End If
    If feld.Length > 2 Then _
      oCell.NumberFormat = getCellFormat(oSM, oDesk, NumberFormats, LocalSettings, feld(2))
    If zName <> "" Then
      oTable = oTables.getByName(repName)
    End If
  Next
 
  If Not dialFlag Then
    If einExt = ".odt" Then
      doSavingOO("Writer-Datei (*.odt)|*.odt", ausgPfad, ausgName, oDoc, ladeZustand, dialFlag)
    Else
      doSavingOO("Calc-Datei (*.ods)|*.ods", ausgPfad, ausgName, oDoc, ladeZustand, dialFlag)
    End If
  Else
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SaveFiledialogOO("Calc-Datei (*.ods)|*.ods", ausgPfad, ausgName, _
      ausgPfad, oDoc, ladeZustand, dialFlag)
  End If
 
  ' OpenOffice sauber (ab)schliessen
  oDoc = Nothing
  oDesk = Nothing
  oSM = Nothing
  killOO()
End Sub

An Hilfsfunktionen werden dieselben wie im Tipp 'Export von VB-Daten nach OpenOffice' benötigt und zusätzlich:

''' <summary>
'''   Format für numerische Werte definieren
''' </summary>
''' <param name="oSm"></param>
''' <param name="oDesk"></param>
''' <param name="nf">die NumberFormats (OO)</param>
''' <param name="ls">die LocalSettings (OO)</param>
''' <param name="form">der Formatstring</param>
''' <returns>NumberFormatId für OO</returns>
Public Function getCellFormat(oSm As Object, oDesk As Object, _
  nf As Object, ls As Object, form As String) As Long
 
  Dim NumberFormatString As String
  Dim NumberFormatId As Long
 
  If form = "" Then Return Nothing
 
  Select Case form
    ' Datum
    Case "d", "d1"
      NumberFormatString = "TT.MM.JJJJ"
    Case "d2"
      NumberFormatString = "TT.MM.JJJJ HH:MM"
 
    ' Währung
    Case "cw"
      NumberFormatString = "#.##0,00 €;[ROT]-#.##0,00 €"
 
    ' Numerisch
    Case "c", "c2"
      NumberFormatString = "#.##0,00 ;[ROT]-#.##0,00"
    Case "c1"
      NumberFormatString = "#.##0,0"
 
    ' Integer
    Case "i"        
      NumberFormatString = "#.##0"
 
    ' Prozent
    Case "p"        
      NumberFormatString = "0 %"
 
    ' Text
    Case "*"        
      NumberFormatString = "#"
 
    ' benutzerdefiniert
    Case Else      
      NumberFormatString = form
  End Select
 
  NumberFormatId = nf.queryKey(NumberFormatString, ls, True)
  If NumberFormatId = -1 Then NumberFormatId = nf.addNew(NumberFormatString, ls)
  Return NumberFormatId
End Function
''' <summary>
'''   Alignment für Werte in einer Zelle setzen
''' </summary>
''' <param name="theTable">die OpenOffice-Tabelle</param>
''' <param name="theCell">die Zelle der Tabelle</param>
''' <param name="align">das Alignment (ParaAdjust)</param>
''' <param name="margin">ein Margin-Wert</param>
Public Sub setCellAlignMarginText(theTable As Object, theCell As Object, _
  align As Short, margin As Short)
 
  Dim oCursor As Object, cName As String
  cName = theCell.CellName
  oCursor = theTable.createCursorByCellName(cName)
  oCursor.ParaAdjust = align  ' Align 
  If align = 0 Then
    oCursor.ParaLeftMargin = margin
  ElseIf align = 1 Then
    oCursor.ParaRightMargin = margin
  End If
  oCursor = Nothing
  ' Die Parameter für ParaAdjust sind:
  ' 0:    Linksbündig (Left)
  ' 1:    Rechtsbündig (Right)
  ' 2:    Blocksatz (BLOCK)
  ' 3:    Zentriert (CENTER)
  ' 4:    Gedehnt (STRETCH)
End Sub
''' <summary>
'''   Konvertieren eines Range-Ausdrucks in numerische Werte
''' </summary>
''' <param name="range">der Rangeausdruck in der Form A1</param>
''' <returns>zweidimensionales Feld mit den zugehörigen Short-Werten</returns>
Public Function convRangeToInt(range As String) As Short()
  Dim intF(1) As Short
  intF(0) = Asc(range.Substring(0, 1)) - 65
  intF(1) = Val(range.Substring(1)) - 1
  Return intF
End Function

Anwendung bei mir von OpenOffice 3.1 bis Apache OpenOffice 4.1.1.



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.