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

https://www.vbarchiv.net
Rubrik: OLE/Registry/DLL · Automation   |   VB-Versionen: VB2008, VB2010, VB201231.08.14
Export von VB-Daten nach OpenOffice

Der Tipp zeigt erste Wege auf, wie man mittels VB.net auch Staroffice-Basic ausführen und damit Daten nach OpenOffice exportieren kann.

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

Innerhalb eines Projektes wurde mir die Aufgabe gestellt, SQL-Daten, die in einem VB-Projekt verarbeitet wurden, in Openoffice Dateien zu speichern und auszugeben. In diesem Tipp zeige ich zunächst eine Vorgehensweise, wie ich diese Aufgabe realisiert habe, und zwar mit Hilfe des Exports der Daten eines DatagridView in eine Openoffice-Calc-Tabelle. Openoffice muss in einer Version >= 3.1 auf dem ausführenden Rechner installiert sein.

Ein paar theoretische Grundlagen zur Verbindung mit Staroffice-Basic habe ich mir über folgende Links angeeignet:
http://www.dannenhoefer.de/faqstarbasic/contents.htm
https://wiki.openoffice.org/wiki/MediaWiki:Collections/BASIC_Guide

Allerdings kann man diese Grundlagen nicht ohne Modifikationen in VB übernehmen. Im Tipp zeige ich, wie die Programmierung mit den gängigsten und meistgebrauchten Funktionen realisiert werden kann.

Zu meiner grundsätzlichen Vorgehensweise ist Folgendes zu sagen:
Die Situation ist also die, dass Daten aus einer SQL-Tabelle in meinem Projekt mittels DatagridView für den Nutzer dargestellt werden, d.h., eine gewisse Aufbereitung der Daten ist erfolgt. Nun habe ich auf einer Festplatte ein Verzeichnis definiert, in dem ich dann so genannte "Belegvorlagen" speichere. Eine Belegvorlage erstelle ich in Openoffice, in diesem Falle eine Calc-Tabelle (.ods). In dieser Tabelle definiere ich die Darstellung der Daten in Tabellenform (Kopfzeile + sequentiell nachfolgende Datenzeilen).

Diese definierte Belegvorlage wird im dafür vorgesehenen Verzeichnis unter ihrem Namen gespeichert.
Es wird außerdem ein Verzeichnis für die auszugebenden Calc-Dateien definiert.

Die im Tipp gezeigte Funktion erstellt aus DGV-Daten eine Calc-Tabelle in Tabellenform.
Wie man sieht ist eine recht umfangreiche Parameterliste definiert. Diese ist an meinen Anwendungsfall angepasst, wer also andere Parameter benötigt, muss die Funktion entsprechend modifizieren.
Die Parameter erklären sich eigentlich von selbst. Bei Fragen kann man die "Diskussion" von vbArchiv benutzen.
Nur eine Erklärung zu "OO beim Prozess verbergen oder nicht": Wenn vom VB.net-Programm der Start des Exports ausgelöst wird, kann man programmtechnisch mittels dieses Parameters steuern, ob sich das Openoffice-Fenster mit der Belegvorlage öffnet und man dann den Fortschritt des Exports der Daten beobachten kann oder im anderen Fall wird der Prozess des Exports so zu sagen im Verborgenen realisiert, das Openoffice-Fenster öffnet nicht, der Dateneintrag erfolgt dennoch.

Der Aufruf der unten aufgeführten Funktion könnte also folgendermaßen geschrieben werden:

writeOODGV(myDGV, myLayouts, firstLayoutTable, myOutputs, firstOutputTable)

mit:

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

Dies ist ein einfacher Fall, die restlichen Parameterwerte werden mit ihren Standards benutzt.

Hier nun die Funktion selbst:

''' <summary>
''' DatagridView nach OpenOffice-Calc exportieren
''' </summary>
''' <param name="dgv">das DatagridView</param>
''' <param name="pfad">Pfad der Belegvorlage</param>
''' <param name="fName">Name der Belegvorlage</param>
''' <param name="ausgPfad">Ausgabepfad für die OO-Datei</param>
''' <param name="ausgName">Name der Ausgabedatei</param>
''' <param name="begZeileDGV">Beginnzeile im DGV</param>
''' <param name="begSpalteDGV">Beginnspalte im DGV</param>
''' <param name="begZeileOO">Beginnzeile im OO-Calc</param>
''' <param name="begSpalteOO">Beginnspalte im OO-Calc</param>
''' <param name="rowBold">Feld von Zeilennummern,
''' die Fett formatiert werden sollen (nur bei nicht-datengebundenem DGV sinnvol)</param>
''' <param name="hideFlag">OO beim Prozess verbergen oder nicht</param>
''' <param name="dialFlag">mit Speichern-Dialog abschließen oder nicht</param>
Public Sub writeOODGV(ByVal dgv As DataGridView, _
  ByVal pfad As String, ByVal fName As String, _
  ByVal ausgPfad As String, ByVal ausgName As String, _
  Optional ByVal begZeileDGV As Short = 0, Optional ByVal begSpalteDGV As Short = 0, _
  Optional ByVal begZeileOO As Short = 0, Optional ByVal begSpalteOO As Short = 0, _
  Optional ByVal rowBold() As Short = Nothing, _
  Optional ByVal hideFlag As Boolean = False, Optional dialFlag As Boolean = False)
 
  ' ttp://www.dannenhoefer.de/faqstarbasic/contents.htm
  ' ttps://wiki.openoffice.org/wiki/MediaWiki:Collections/BASIC_Guide
 
  ' Hauptobjekt für den Zugriff auf OpenOffice von VB.Net aus (SM: ServiceManager)
  Dim oSM As Object
 
  ' Objekte von der OpenOffice-Schnittstelle (API)
  Dim oDesk, oDoc, oSheet, oCell As Object
  Dim NumberFormats, LocalSettings, StyleFamilies As Object
  Dim NumberFormatString As String
  Dim NumberFormatId As Long
 
  Try
    ' OpenOffice instanziieren
    ' Zwingend notwenig für die Kommunikation von VB.Net mit OpenOffice API
    oSM = CreateObject("com.sun.star.ServiceManager")
    ' Erstellen des ersten und wichtigsten Diensts
    oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
  Catch ex As Exception
    MessageBox.Show(ex.Message, "FEHLER OpenOffice", _
      MessageBoxButtons.OK, MessageBoxIcon.Warning)
    Clipboard.SetText(ex.Message)
    Exit Sub
  End Try
 
  ' Um OO-Calc im Hintergrund zu halten oder nicht
  Dim ladeZustand(0)
  ladeZustand(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  ladeZustand(0).Name = "Hidden"
  ladeZustand(0).Value = hideFlag
 
  ' Erstellen eines neuen OO-Calc-Tabellendokuments auf Basis einer Vorlage
  ' und gemäß OO-URL-Restriktionen
  Dim str As String = pfad + fName + ".ods"
  str = str.Replace("\", "/")
  str = "file:///" + str.Replace(":", "|")
  Try
    ' Vorlage laden gemäß Ladezustand (also sichtbar oder nicht)
    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)
    Clipboard.SetText(ex.Message)
    Exit Sub
  End Try
  StyleFamilies = oDoc.StyleFamilies
  ' Formatierung numerischer Werte vorbereiten
  NumberFormats = oDoc.NumberFormats
  NumberFormatString = "#.##0,00 ;[ROT]-#.##0,00"  ' Dezimalwert; negative Werte in rot
  NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
  If NumberFormatId = -1 Then
    NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings)
  End If
 
  ' vom DatagridView übernehmen
  Dim anzCols, anzRows As Integer, value As String
  anzCols = dgv.ColumnCount  ' Anzahl Spalten des DGV
  anzRows = dgv.RowCount     ' Anzahl Zeilen des DGV
 
  ' Bezugspunkt: 1.Blatt der OpenOffice-Calc-Mappe (0-indiziert)
  oSheet = oDoc.getSheets().getByIndex(0)
  ' erste Zelle des Blattes
  oCell = oSheet.getCellByPosition(0, 0)
 
  ' OO-Calc-Tabelle füllen mit DGV-Inhalt
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Dim i, j, idx, lastC, lastR As Short
  Dim d, k, l As Short
  ' Beginnzeile/BeginnSpalte in OO-Tabelle festlegen
  k = begZeileOO
  l = begSpalteOO
  d = begZeileOO - begZeileDGV - 1
 
  ' von BeginnZeile des DGV bis zur letzten Zeile
  For i = begZeileDGV To anzRows - 1
 
    ' von BeginnSpalte des DGV bis zur letzten Spalte
    For j = begSpalteDGV To anzCols - 1
      If dgv.Columns(j).Visible Then  
        ' nur sichtbare Spalten übertragen
        value = 0
        If Not IsDBNull(dgv.Rows(i).Cells(j).Value) Then value = dgv.Rows(i).Cells(j).Value
 
        ' auf aktuelle OO-Zelle positionieren
        oCell = oSheet.getCellByPosition(l, k)
 
        ' Zellfarben vorbereiten für Übergabe an OO
        Dim hco As String = ColorToHEX(dgv.Rows(i).DefaultCellStyle.BackColor, "&H")
 
        ' schwarz gegen weiß tauschen (??)
        Dim hcz As String = hco
        If hcz = "&H000000" Then hco = "&HFFFFFF"
        If hcz = "&HFFFFFF" Then hco = "&H000000"
        oCell.CellBackColor = hco  'Hintergrundfarbe der Zelle setzen
 
        idx = dgv.Columns(j).Index  ' aktueller Spaltenindex des DGV
        ' das Formatieren individuell programmieren
        ' hier bspw. erste Spalte als Text, alle anderen Spalten numerisch mit Zahlenformat
        Select Case idx
          Case 1
            oCell.String = value
          Case Else
            oCell.Value = CDec(value)
            oCell.NumberFormat = NumberFormatId
        End Select
        ' eventuelles fett-formatieren einer Zeile (siehe Parameterbeschreibung)
        If rowBold.IndexOf(rowBold, k - d) >= 0 Then oCell.CharWeight = 150 ' bold
        l += 1
      End If
    Next j
 
    k += 1
    lastC = l
    l = begSpalteOO
  Next i
  lastR = k
 
  ' die Spaltenbreiten in OO-Calc optimieren
  For i = 0 To lastC - 1
    oCell = oSheet.getCellByPosition(i, 0)
    oSheet.Columns(i).OptimalWidth = True
  Next
 
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Datei über Speichern-Dialog abspeichern
  If Not dialFlag Then
    doSavingOO("Calc-Datei (*.ods)|*.ods", ausgPfad, ausgName, oDoc, ladeZustand, dialFlag)
  Else
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SaveFiledialogOO("Calc-Datei (*.ods)|*.ods", ausgPfad, ausgName, _
      ausgPfad, oDoc, ladeZustand, dialFlag
  End If
 
  ' OpenOffice abschliessen
  oDoc.Close(True)
  oDoc = Nothing
  oSheet = Nothing
  oDesk = Nothing
  oSM = Nothing
  killOO()
End Sub

Und noch drei Hilfsfunktionen, die ebenfalls recht spezifisch sind und eventuell angepasst werden können:

Public Sub doSavingOO(ByVal theFilter As String, _
  ByVal ausPfad As String, ByVal fName As String, ByVal oDoc As Object, _
  ByVal ladeZ As Object, diaFlag As Boolean)
 
  Dim sURL, sUrlT, sPath As String
  If diaFlag Then
    sPath = Path.GetDirectoryName(fName) + "\"
    If ausPfad <> sPath Then ausPfad = sPath
    sURL = Replace(ausPfad + Path.GetFileName(fName), "\", "/")
  Else
    sURL = Replace(ausPfad + fName, "\", "/")
  End If
  sUrlT = sURL
  sURL = "file:///" + sURL.Replace(":", "|")
 
  Dim res As DialogResult
  Try
    If Not diaFlag Then
      ' Datei wird als odt|ods-Format abgespeichert
      oDoc.storeToURL(sURL, ladeZ)    
    Else
      Dim t As String = _
        "Die Daten unter" + vbCrLf + vbCrLf + sUrlT.Substring(0, sUrlT.LastIndexOf("/") + 1) + _
        vbCrLf + sUrlT.Substring(sUrlT.LastIndexOf("/") + 1) + vbCrLf + vbCrLf + "speichern?"
      res = MessageBox.Show(t, "MELDUNG", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
      If res = vbYes Then
        oDoc.storeToURL(sURL, ladeZ)    ' Datei wird als odt|ods-Format abgespeichert
      End If
    End If
  Catch ex As Exception
    MessageBox.Show(ex.Message, "FEHLER", MessageBoxButtons.OK, MessageBoxIcon.Error)
  Finally
    If Not diaFlag And res = vbYes Then
      Dim t As String = "Die Daten wurden gespeichert!"
      MessageBox.Show(t, "MELDUNG", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End If
  End Try
End Sub
' der Dialog zum Speichern OO-Dateien
Public Function SaveFiledialogOO(ByVal theFilter As String, ByVal iniDir As String, _
  ByVal fName As String, ByVal ausPfad As String, _
  ByVal oDoc As Object, ByVal ladeZ As Object, dialflag As Boolean) As DialogResult
 
  ' Datei über Speichern-Dialog abspeichern
  ' Dim sURL, sPath As String
  Dim save As New SaveFileDialog
  With save
    .Filter = theFilter
    .FilterIndex = 1
    .InitialDirectory = iniDir
    .RestoreDirectory = True
    .Title = ("Datei speichern unter:")
    .OverwritePrompt = True
    .FileName = fName
    'Zeigt den Datei-Dialog an
    If .ShowDialog = DialogResult.OK Then
      doSavingOO(theFilter, fName, ausPfad, oDoc, ladeZ, dialflag)
    End If
  End With
End Function
' Beenden von OO-Prozess
Public Sub killOO(Optional procName As String = "soffice")
  Dim proc As System.Diagnostics.Process
  Dim pList() As Process
  pList = Process.GetProcessesByName(procName)
  For Each proc In pList
    With proc
      ' .Kill()
      ' .WaitForExit()
    End With
  Next
End Sub

Diese Arbeitsweise wende ich seit Openoffice 3.1 an, habe aber mittlerweile durch Updates Apache Openoffice 4.0.1 in Gebrauch.
Nun wünsche ich viel Erfolg mit der Anwendung!



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.