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

https://www.vbarchiv.net
Rubrik: OLE/Registry/DLL · Automation   |   VB-Versionen: VB2008, VB2010, VB201208.09.14
Colorieren von Zeilen einer OpenOffice-Calc-Tabelle

Zwei Funktionen für das alternative Färben von Tabellenzeilen (zweifarbig) bzw. das Färben von Zeilengruppen (zweifarbig) auf Grund eines vorgebenen Spaltenwerts.

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

Dieser Tipp ergänzt in gewisser Weise meinen Tipp  Export von VB-Daten nach OpenOffice.
Die beiden Funktionen werden eingesetzt, nachdem die Calc-Tabelle erzeugt wurde, also wenn alle Spalten und Zeilen komplett sind.

Mit der ersten Funktion kann alternierend jede zweite Zeile mit einer Farbe im Hintergrund gekennzeichnet werden.

Aufruf:

setAlterRowColors(oSheet, Color.LightGray)

mit oSheet ist die Calc-Tabelle.

Der Code:

''' <summary>
'''   alternierender Zeilenhintergrund
''' </summary>
''' <param name="theTable">die OpenOffice-Calc-Tabelle</param>
''' <param name="Color1">Farbe1</param>
''' <param name="Color2">Farbe2</param>
Public Sub setAlterRowColors(theTable As Object, Color1 As Object, _
  Optional Color2 As Object = Nothing)
  Dim aCell As Object
  For i As Integer = 1 To theTable.Rows.getCount() - 1
    For j As Integer = 0 To theTable.Columns.getCount() - 1
      If i Mod 2 <> 0 Then
        aCell = theTable.getCellByPosition(j, i)
        aCell.BackColor = ColorToHEX(Color1, "&H")
      Else
        If Not IsNothing(Color2) Then
          aCell = theTable.getCellByPosition(j, i)
          aCell.BackColor = ColorToHEX(Color2, "&H")
        End If
      End If
      aCell.CharColor = GegenFarbe_sw(aCell.Backcolor)
    Next
  Next 
End Sub

Mit der zweiten Funktion werden Zeilengruppen gebildet auf Grund des Wertes in einer vorgegebenen Spalte. Die Gruppen werden dann alternierend mit je einer Farbe im Hintergrund gekennzeichnet. Voraussetzung der Funktion ist die Sortierung der speziellen Spalte.

Aufruf:

coloredOCalcRowsOfValue(oSheet, 1, 50, 5, 0, Color.MistyRose, Color.LightGray , False)

mit oSheet ist die Calc-Tabelle.

Der Code:

''' <summary>
''' Erzeugen gefärbter Zeilengruppen (alternierend) auf Grund von Wert in speziellem Feld
''' in OpenOffice-Calc-Tabellen
''' </summary>
''' <param name="ooCalc">die OpenOffice-Calc-Tabelle</param>
''' <param name="anfRow">Anfangszeile</param>
''' <param name="endRow">Endzeile</param>
''' <param name="colCount">Spaltenanzahl</param>
''' <param name="compCol">Spalte mit dem speziellen Wert</param>
''' <param name="Color1">Farbe1</param>
''' <param name="Color2">Farbe2</param>
''' <param name="anzFlag">wenn ja, wird Wert von compCol angezeigt, sonst nicht</param>
''' <param name="anzCols">Feld der Spalten, die in Anzeige einbezogen werden gemäß anzFlag</param>
Public Sub coloredOCalcRowsOfValue(ByVal ooCalc As Object, _
  ByVal anfRow As Integer, _
  ByVal endRow As Integer, _
  ByVal colCount As Short, _
  ByVal compCol As Short, _
  ByVal Color1 As Color, _
  ByVal Color2 As Color, _
  Optional ByVal anzFlag As Boolean = True, _
  Optional ByVal anzCols() As Object = Nothing)
 
  Dim oRange, oCell As Object
  Dim cColor As Color = Color1
  Dim lastValue, aktValue As Object
 
  With ooCalc
    For i As Short = anfRow To endRow
      oRange = .getCellRangeByPosition(0, i, colCount - 1, i)
      oCell = .getCellByPosition(compCol, i)
      aktValue = oCell.String
      If lastValue Is Nothing OrElse Not lastValue.Equals(aktValue) Then
        lastValue = aktValue
        If cColor = Color2 Then cColor = Color1 Else cColor = Color2
      Else
        If Not anzFlag Then
          oCell = .getCellByPosition(compCol, i)
          oCell.String = ""
          If anzCols IsNot Nothing Then
            For j As Short = 0 To anzCols.Length - 1
              oCell = .getCellByPosition(anzCols(j), i)
              oCell.String = ""
            Next
          End If
        End If
      End If
      oRange.CellBackColor = cColor
      If anzFlag Then oRange.CharColor = GegenFarbe_sw(cColor)
    Next i
  End With
End Sub

Für die Anwendung der Funktionen wird als zusätzliche Hilfsfunktion gebraucht:

''' <summary>
''' Klare Textfarbe (S/W) bei variabler Hintergrundfarbe
''' </summary>
''' <param name="farbe">Backgroundfarbe</param>
''' <returns>Foregroundfarbe schwarz oder weiß</returns>
Public Function GegenFarbe_sw(farbe As Color) As Color
  Dim R As Integer = farbe.R  ' Farb-Anteile
  Dim G As Integer = farbe.G
  Dim B As Integer = farbe.B
  R = R * 2 : G = G * 5 : B = B
  If R + G + B > 1024 Then
    Return Color.Black    ' schwarz, weil sehr hell
  Else
    Return Color.White    ' weiss, weil sehr dunkel
  End If
End Function



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.