Best Practices > Diskussionen zu Best Practices

COM-Schnittstelle MS Excel

<< < (5/8) > >>

ata:
... eine Funktion zur Schrift-Formattierung eines Bereiches

Ein Aufruf kann wie folgt aussehen:
Call xlFormatFont( xl , xlSheet , "" , "Arial" ) ' # das gesamte Tabellenblatt in Arial
Call xlFormatFont( xl , xlSheet , "" , "Arial => 10" ) ' # das gesamte Tabellenblatt in Arial Größe 10 - verwendet Select
Call xlFormatFont( xl , xlSheet , "" , "Arial => 10 => 3" ) ' # das gesamte Tabellenblatt in Arial Größe 10 in roter Schriftfarbe
Call xlFormatFont( xl , xlSheet , "A1:E1" , "Arial => 14 => 3 => Bold => Italic" )  '# der ausgewiesene Bereich in fetter roter Kursiv-Schrift "Arial in Größe 14
Call xlFormatFont( xl , xlSheet , "A1:E1" , "Arial => 14 => 5 => => Italic" ) '# der ausgewiesene Bereich in blauer Kursiv-Schrift "Arial in Größe 14

Hinweis:
Die Parameter für die Schriftformatierung müssen in dieser Reihenfolge verwendet werden.
Es kann kein Parameter übersprungen werden, er muß zumindest als Leer übergeben werden (s. letztes Beispiel für "Bold"-Bereich des Strings).
Leere Parameter werden nicht beachtet.


--- Code: ---Function xlFormatFont( xl As Variant , xlSheet As Variant , vRange As Variant , vParam As Variant ) As Variant
   ' # Formatiert einen Bereich für Schrift, Größe, Farbe
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # vRange => Variant => z.B. "A:E" für die ersten 5 Spalten - bei Leersting das gesamte Arbeitsblatt
   ' # vParam => Variant => gewünschte Formatierung des Bereiches "Schrift => Größe => Farbnummer => Gewicht => Kursiv"
   ' # ... => z.B. "Arial => 10 => 3 => Bold => kursiv " für Arial in Größe 10 in fetter roter Kursiv-Schrift
   ' # ... => z.B. "Arial => 10 => 3 => Normal => kursiv " für Arial in Größe 10 in roter Kursiv-Schrift
   '
   On Error GoTo GeneralError
   '
   Dim sFont As String
   Dim sSize As String
   Dim sColor As String
   Dim sWeight As String
   Dim sItalic As String
   '
   Dim Range As Variant
   Dim vValue As Variant
   Dim i As Integer
   Dim sValue As String
   Dim sMsg As String
   '
   ' # Parsen der Übergabeparameter
   ' # ... Fontangaben
   If Instr( Cstr( vParam ) , "=>" ) > 0 Then
      vValue = Split( Trim(Cstr(vParam)) , "=>" )
      sFont =  Trim(Cstr(vValue(0)))
      sSize =  Trim(Cstr(vValue(1)))
      If Ubound( vValue ) > 1 Then sColor =  Trim(Cstr(vValue(2)))
      If Ubound( vValue ) > 2 Then sWeight =  LCase( Trim(Cstr(vValue(3))))
      If Ubound( vValue ) > 3 Then sItalic =  LCase( Trim(Cstr(vValue(4))))
   Else
      sFont = Cstr( vParam )
   End If
   '
   ' # Formatieren des Bereiches
   If Trim(Cstr( vRange )) = "" Then
      xlSheet.Cells.Select
      Set Range = xl.Selection
   Else
      Set Range = xlSheet.Range( vRange  )
   End If
   If sFont <> "" Then Range.Font.Name = sFont
   If sSize <> "" Then Range.Font.Size = Cdbl( sSize )
   If sColor <> "" Then Range.Font.ColorIndex = Cdbl( sColor )
   If sWeight <> "" Then
      If sWeight = "bold" Or sWeight = "fett" Then Range.Font.Bold = True
      If sWeight = "normal" Then Range.Font.Bold = False
   End If
   If sItalic <> "" Then
      If sItalic = "italic" Or sItalic = "kursiv" Then Range.Font.Italic = True
      If sItalic = "normal" Then Range.Font.Italic = False
   End If
   '
   If Trim( Cstr( vRange ) ) = "" Then xlSheet.Range( "A1" ).Select   
  '
WayOut:
   Exit Function
GeneralError:
    xl.Visible = False
    sMsg =  "Fehler (Nr. " & err & ") in Zeile " & Erl & ": " & Error
    sMsg = sMsg & Chr(10) & Chr(10)
    sMsg = sMsg & "Parameter: " & Chr(10)
    sMsg = sMsg & "Bereich = " & Cstr( vRange ) & Chr(10)
    sMsg = sMsg & "Angaben = " & Cstr( vParam ) & Chr(10)
    sMsg = sMsg & "Schriftart = " & Cstr( sFont ) & Chr(10)
    sMsg = sMsg & "Schriftgröße = " & Cstr( sSize ) & Chr(10)
    sMsg = sMsg & "Schriftfarbe = " & Cstr( sColor ) & Chr(10)
    If Err = 213 And Error = "OLE: Automation object error" Then
       sMsg = sMsg & Chr(10) & Chr(10)
       sMsg = sMsg & "Hinweis: " & Chr(10) & "MS Excel meldet einen generellen Fehler." & Chr(10)
       sMsg = sMsg & "Überprüfen sie die Angaben des Bereiches. Sie dürfen nur maximal einen Doppelpunkt enthalten, "
       sMsg = sMsg & "Zeilen- und Reihenangaben müssen plausibel sein." & Chr(10)
       sMsg = sMsg & ""
    End If
    MsgBox sMsg  , 16 ,  "Fehler in Funktion xlFormatFont()"
    xl.Visible = True
    Resume Next
End Function

--- Ende Code ---

ata:
... dynamische Funktion zum Beschreiben von Excel-Zellen.

Ein Aufruf kann wie folgt aussehen:
' # Zeile 2, Spalte 1, Erstellungsdatum des Dokumentes im Format "dd.mm.yyyy hh:nn"
Call xlSetCell( xl , xlSheet , 2 , 1 , doc.Created , "TT.MM.JJJJ hh:mm" )

' # Zeile 2, Spalte 2, angenommene Postleitzahl als Text in die Zelle schreiben - um führende Nullen nicht zu verlieren
Call xlSetCell( xl , xlSheet , 2 , 2 , doc.PLZ(0) , "@" )

' # Zeile 2, Spalte 3 , Formel für den Inhalt => A2 + ", " + B2
row = 2
Call xlSetCell( xl , xlSheet , row , 3 , {=VERKETTEN(A} & row & {;", ";B} & row &{)}  , "" ) ' # Formelsprache beachten...


Hinweis:
Es gibt für Excel auch einen Parameter, mit dem man die Formelsprache für englische Formelsprache erzwingen kann - dann dürfen aber nur noch solche verwendet werden. Notwendig wird dies, wenn unterschiedliche Excel-Versionen und Ländereinstellungen vorliegen.

Der Parameter wird später nachgereicht - bin noch am suchen  :P


--- Zitat ---Function xlSetCell( xl As Variant , xlSheet As Variant , row As Long , column As Variant , vValues As Variant , sDataFormat As String ) As Variant
   ' # Einen Wert oder eine Formel in eine Zelle schreiben unter Berücksichtigung eines speziellen Formates.
   ' # xl => Variant => die Excel-Anwendung
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # row => Zahl => die Zeilennummer
   ' # column => Zahl => die Spaltennummer
   ' # vValue => Text-Array oder TextString => die eigentlichen Werte. Bei einem Array werden alle Elemente mit einem LineFeed (Chr(10)) als Textstring verkettet.
   ' # ... beginnt der Textstring mit einem Gleichheitszeichen, dann wird der String als Formel in die Zelle geschrieben.
   ' # ... bei Formeln muß beachtet werden, daß es bei unterschiedlichen Excel-Versionen zu Abweichungen in der Syntax kommen kann.
   ' # ... die engliche Formlsprache ist vorzuziehen
   ' # sDataFormat => Text-String => das zu verwendende Zell-Format. Bei Leerstring findet keine Formatierung statt.
   ' # ... ACHTUNG: Hier gibt es je nach Länder- und Excel-Version unterschiedliche Formtierungsparameter - gilt für vor allem für Zahlen und Datums-/Zeitformatierungen
   ' # ... "@" => Zelle wird explicit als Text formatiert
   ' # ... "#.##0,00" => Zelle wird als Zahl mit 2 Nachkomma-Stellen und möglichem Tausender-Trennzeichen "." formatiert
   ' # ... "TT.MM.JJJJ hh:mm:ss" => Zelle wird als Datums-/Zeit-Wert formatiert, hier z.B. "31.01.2008 13:54:00" => deutsche Excel-Version 2003
   '
   Dim i As Integer
   Dim sValue As String
   Dim sMsg As String
   '
   On Error GoTo GeneralError
   '
   If IsArray( vValues ) Then
         For i = LBound( vValues ) To Ubound( vValues )
            sValue = sValue + vValues( i ) + Chr(10)
         Next
         sValue = Left( sValue , Len( sValue ) - 1 ) ' # letzten LF bereinigen
         xlSheet.Cells( row , column ).Value = sValue
   Else
      If Left( Cstr( vValues ) , 1 ) = "=" Then
         sValue = Cstr( vValues )
         xlSheet.Cells( row , column ).FormulaLocal = sValue
      Else
         If sDataFormat <> "" Then xlSheet.Cells( row , column ).NumberFormat = sDataFormat
         sValue = Cstr( vValues )
         xlSheet.Cells( row , column ).Value = vValues
      End If
   End If
   '
WayOut:
   Exit Function
GeneralError:
    xl.Visible = False
    sMsg =  "Fehler (Nr. " & err & ") in Zeile " & Erl & ": " & Error
    sMsg = sMsg & Chr(10) & Chr(10)
    sMsg = sMsg & "Parameter: " & Chr(10)
    sMsg = sMsg & "Zeile = " & Cstr( row ) & Chr(10)
    sMsg = sMsg & "Spalte = " & Cstr( column ) & Chr(10)
    sMsg = sMsg & "Werte = " & Cstr( sValue ) & Chr(10)
    sMsg = sMsg & "Format = " & Cstr( sDataFormat ) & Chr(10)
    If Error = "OLE: Automation object error" Then
       sMsg = sMsg & Chr(10) & Chr(10)
       sMsg = sMsg & "Hinweis: " & Chr(10) & "MS Excel meldet einen generellen Fehler." & Chr(10)
       sMsg = sMsg & "Überprüfen sie die oben angegebenen Parameter auf ihre Plausibilität." & Chr(10)
       sMsg = sMsg & ""
    End If
    MsgBox sMsg  , 16 ,  "Fehler in Funktion xlSetCell()"
    xl.Visible = True
    Resume Next
End Function

--- Ende Zitat ---

ata:
... aktivieren des Autofilters in einer bestimmten Zeile.

Ein Aufruf kann wie folgt aussehen:
' # 5. Zeile für den Autofilter aktivieren
Call xlAutoFilter( xlSheet , 5 )


--- Code: ---Function xlAutoFilter( xlSheet As Variant , row As Long ) As Variant
   ' # Setzt in der angegebenen Zeile den Autofilter
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # row => Zahl => die Zeilennummer
   '
   xlSheet.Rows( row ).Select
   xl.Selection.AutoFilter
   '
End Function

--- Ende Code ---

jBubbleBoy:
... meine Funktion zum hochzählen der Spalten, die habe ich in deiner Liste noch nicht gesehen oder machst du das anders ;)


--- Code: ---Function getNextColumn( column As String ) as string
      Dim fi$, la$
      If Len(column)>1 Then
          fi=Left(column,1)
          la = Right(column, 1)
      Else
            la = column
      end if
      If Asc( la ) = 90 Then
            If fi<>"" Then
                  getNextColumn = Chr( Asc( fi  ) +1 )      + "A"
            Else
                  getNextColumn = "AA"
            End If
      Else
            getNextColumn = fi & Chr( Asc( la ) +1 )
      End If
End Function

--- Ende Code ---

ata:
... es gibt ja bekanntlich immer viele Wege nach Rom - ich mach es über Evaluate, Permutation und ein Array - kommt noch im Laufe des Tages...


Toni

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete