Dieser Tipp ergänzt in gewisser Weise meinen Tipp Export von VB-Daten nach OpenOffice. 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 Dieser Tipp wurde bereits 8.120 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |