COM-Schnittstelle MS Excel

[ata]

Hallo @All,

im Laufe der Zeit steht man immer wieder vor den gleichen Anforderungen. Da ich in der letzten Zeit häufiger auf Excel angesprochen wurde, kam mir der Gedanke hier eine Sammlung von rudimentären Funktionen einzubringen, die man immer wieder im Zusammenhang mit COM-Schnittstellenprogrammierung braucht...

Die Funktionen können dann in einer Library oder auch direkt verwendet werden. Sie basieren auf den aktuellen COM-Klassenobjekten.

Für eine bessere Navigation würde ich pro Funktion eine Antwort erstellen - die Überschrift enthält den Funktionsnamen.

Gibt es daran Interesse?

Toni



*** edit ***


Hier der Beginn einer Auflistung aller bisherigen Funktionen:

Excel als Variant initialisieren
Function xlGet( ... )

Excel im Backend schließen
Function xlClose( ... )

Excel im Frontend anzeigen oder verbergen
Function xlShow( ... )

Zellinhalte auslesen - mit der Möglichkeit mehrere Zellen einer Zeile einzulesen
Function xlGetCellValues( ... )

Werte in eine Excel-Zelle schreiben - mit der Option einer Zellformatierung für Darstellungsformat
Function xlSetCell( ... )

Hilsfunktion zum Initialisieren der möglichen 256 Spaltennamen ( A - IV ) in eine Textliste
Function xlGetColumnNames( )

Importieren einer ASCII-Datei
Function xlDataImport(...)

Einen Tabellenbereich nach einer Spalte sortieren
Function xlSort( ... )

Zellen in Höhe und Breite automatisch anpassen - für gesamtes Tabellenblatt
Function xlAutoFit( ... )

Einen Tabellenbereich in Höhe und Breite anpassen
Function xlFitRange( ... )

Zellen miteinander verbinden
Function xlMergeCells(...)

Schriftformatierung für einen Bereich - Schriftart und -größe, Gewicht und Kursiv
Function xlFormatFont( ... )

Tabellenblatt an einer bestimmten Stelle einfrieren
Function xlFreeze( ... )


... Fortsetzung folgt...

[ata]

Code

Function xlGet( sPath As String , bVisible As Variant , xl As Variant , xlWbk As Variant ) As Variant
   ' # Initialisierung einer Excel-Anwendung.
   ' # sPath => String-Variable für die vollständige Pfadangabe einer Excel-Datei oder Leersting
   ' # bVisible => True oder False für die Sichtbarkeit im Frontend
   ' # xl => Variant-Variable für das Excel-Objekt
   ' # xlWbk => Variant-Variable für die Excel-Datei
   ' # Rückgabe ist xl Als Applikation
   '
   On Error Resume Next
   '
   Set xl = GetObject("", "Excel.Application")
   '
   If Err = 208 Then  '  Fehler 208 tritt auf wenn Excel noch nicht läuft
     Err = 0
     Set xl = CreateObject( "Excel.Application" )   'Excel wird initialisiert
   End If
   '
   If Not xl Is Nothing Then
      XL.Visible = bVisible
      If sPath <> "" Then
         Set xlWbk = xl.Workbooks.Open( sPath ) ' # bestehende Datei öffnen
      Else
         Set xlWbk = xl.Workbooks.Add ' # neue Datei verwenden
      End If
      Print "OK - Excel konnte initialisiert werden"
      Set xlGet = xl
   Else
      Set xlGet = Nothing
   End If
End Function

Eine Validierung, ob eine bestimmte Datei am angegebenen Pfad existiert muß zuvor separat durchgeführt werden...

Toni

[Axel]

Code

'--- Deklaration von API-Funktionen ---
Declare Function SetActiveWindow Lib "user32" Alias "SetActiveWindow" (Byval Hwnd As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (Byval Hwnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (Byval ClassName As String, Byval lpWindowName As Long) As Long

Class cExcel
	
  objExcel As Variant
  objSheet As Variant    
	
	
'Konstruktor 
  Sub New
    Set objExcel = Nothing
	
    On Error Resume Next
		
    Set objExcel = GetObject("", "Excel.Application")
    If Err = 208 Then  '  Fehler 208 tritt auf wenn Excel noch nicht läuft
      Err = 0
      Set objExcel = CreateObject("Excel.Application")   'Excel wird "unsichtbar" gestartet
    End If  'If Err = 208 Then
  
  End Sub
	
	
'Destruktor-Prozedur
  Sub Delete
    Set objExcel = Nothing         
  End Sub
	
	
'Beendet den Excel-Task, es werden alle offenen Arbeitsmappen ohne Speicherung geschlossen
  Sub Quit
    objExcel.DisplayAlerts = False  'Warnmeldungen ausschalten
    Call objExcel.Quit
  End Sub
	
	
' Macht den Excel-Task sichbar
  Sub SetVisible
    objExcel.Visible = True  'Excel sichtbar machen
  End Sub	
	
	
'Bringt Word als Vollbild in den Vordergrund
  Sub ActivateExcel
		
    Dim hWnd As Long
		
    'Handle für Excel-Application ermittlen
    hWnd = FindWindow("XLMAIN", 0)
    If hWnd = 0 Then Exit Sub
		
    'Excel aktivieren und in den Vordergrund bringen
    Call SetActiveWindow(hWnd)
    Call SetForegroundWindow(hWnd)
  End Sub
	
	
'  Erstellt eine neue Arbeitsmappe     
  Sub NewWorkbook
    Call objExcel.Workbooks.Add
    Set objSheet = objExcel.Workbooks(1).Worksheets(1)
  End Sub
	
	
'  Öffnet eine Arbeitsmappe     
  Sub OpenWorkbook(strFileName As String)
    Call objExcel.Workbooks.Open (strFileName)
    Set objSheet = objExcel.Workbooks(1).Worksheets(1)
  End Sub
	
	
'  Schreibt einen Wert in die angegebene Zelle
'  Es werden nur maximal 912 Zeichen übernommen
  Sub SetCellValue(sZiel As Variant, varValue As Variant)
		
    Dim sTmp As String		
    Dim result As Variant
		
    sTmp = Cstr(varValue)
		
    If Len(sTmp) > 912 Then
      objSheet.Range(sZiel).Value = Left(sTmp,912)
    Else
      objSheet.Range(sZiel).Value = sTmp
    End If  'If Len(varValue) > 912 Then
  End Sub
	
End Class

Der Code ist an manchen Ecken noch etwas rudimentär und stellenweise auch noch felxibler gestaltbar. Es fehlt auch noch eine durchgängige Fehlerbehandlung.


Axel
 

[ata]

... zum Ende des Codes sollte die Excel-Datei aufgeräumt werden, damit die Anwendung nicht im Backend erhalten bleibt.
... die Funktion sollte auch in einem Fehlerhandling eingesetzt werden

Code

Function xlClose( xl As Variant , xlWbk As Variant ) As Variant
   ' # Excel ohne Speicherdialog schließen
   ' # xl => Variant => Excal-Applikation
   ' # xlWbk => Variant => Excel-Datei
   ' # Rückgabe => True
   '
   xl.DisplayAlerts = False  'Warnmeldungen ausschalten
   '
   Call xlWbk.Close( False )
   '
   Call xl.Quit(  )
   Set xl = Nothing
   '
   xlClose = True
   '
End Function

[ata]

... alle Spalten und Zeilen eines Arbeitsblattes in der Breite optimieren

Code

Function xlAutoFit( xl As Variant , xlSheet As Variant )
   ' # Alle Spalten automatisch optimiert in der Breite formatieren.
   ' # xl => Variant => Die Excel-Anwendung
   ' # xlSheet => Variant => das gewünschte Excel-Arbeitsblatt
   '
   xlSheet.Cells.Select
   '
   xl.Selection.Columns.AutoFit
   xl.Selection.Rows.AutoFit
   '
End Function

[ata]

... dynamische Funktion zum zeilenorientierten Auslesen von Excel-Zell-Werten

Es ist zu beachten, daß die Rückgabe "vRes" immer ein String-Array ist und als Variant deklariert werden muß

...
Dim vRes As Variant

vRes = xlGetCellValues( xlSheet,  1 , 10 ) ' # liest die 10. Spalte der 1. Reihe des Tabellenblattes ein
vRes = xlGetCellValues( xlSheet , 1 , 0 ) ' # liest alle 255 Spalten der 1. Reihe des Tabellenblattes  ein
vRes = xlGetCellValues( xlSheet , 1 , -10 ) ' # liest die ersten 10 Spalten der 1. Reihe des Tabellenblattes ein
vRes = xlGetCellValues( xlSheet , 1 , 99999 ) ' # liest bis zur ersten leeren Spalte der 1. Reihe des Tabellenblattes ein

Code

Function xlGetCellValues( xlSheet As Variant , row As Variant , column As Variant ) As Variant
   ' # Einlesen von Excel-Werten 
   Dim sDummy( 0 to 0 ) As String
   Dim vValue As Variant
   Dim i As Integer
   '
   On Error Goto GeneralError
   '
   If column > 0 And column <= 255 Then
      sDummy( 0 ) = xlSheet.Cells( row , column ).Value
      xlGetCellValues =  sDummy
   Else
      vValue = sDummy
      If column = 0 Then 
         column = 254
      Elseif column = 99999 Then
          i = 1
          While Trim( xlSheet.Cells( row , i ).Value ) <> ""
             i = i + 1
          Wend
          column = i
      Else
         column = ( column * ( -1 ) ) - 1
      End If
      Redim vValue( 0 to column )
      For i = 0 to column
         vValue( i ) = Trim( Cstr( xlSheet.Cells( row , i + 1 ).Value ) )
      Next
      xlGetCellValues =  vValue
   End If
WayOut:
   Exit Function		
GeneralError:
   xlGetCellValues = sDummy
   Resume WayOut
End Function

[ata]

... kann man beim Export gut verwenden, um ein Arbeitsblatt an einer bestimmten Stelle zu fixieren...

Code

Function xlFreeze( xl As Variant , xlSheet As Variant , row As Long , column As Integer ) As Variant
   ' # Einfrieren eines Arbeitsblattes für besseres Scrollen.
   Call xlSheet.Select
   Call xlSheet.Cells( row , column ).Select
   xl.ActiveWindow.FreezePanes = True
End Function

[ata]

... sortieren eines Bereiches eines Arbeitsblattes anhand eines Spaltenbereiches...

Ein Aufruf kann wie folgt aussehen:
' # Sortieren der Spalten 1 - 6 von Zeile 2 bis 21 anhand der ersten Spalte "A"
Call xlSort( xlSheet , "A2:F21" , "A2:A21" )

Code

Function xlSort( xlSheet As Variant , sDataRange As String , sColumnRange As String ) As Variant
   ' # sDataRange => der gesamte Bereich mit Daten => "A2:F20" bei Kopfzeile, 5 Spalten und 19 Daten-Zeilen
   ' # sColumnRange => Die Spalte, nach der sortiert werden soll => "A2:A20" bei Kopfzeile und 19 Daten-Zeilen
   Call xlSheet.Range( sRange ).Sort( xlSheet.Range( sColumnRange ) , 1 )
End Function

[Axel]

Formatieren von Zellen

Code

'Konstanten für die vertikale Ausrichtung innerhalb der Zellen
Const xlVAlignTop = -4160
Const xlVAlignBottom = -4107
Const xlVAlignCenter = -4108

'Formatiert ein Arbeitsblatt mit den Attributen vertikale Textausrichtung oben und
'optimale Spaltenbreite
  Sub FormatRangeAlignment
    objSheet.Cells.Select  'Gesamtes Arbeitsblatt markieren
    objExcel.Selection.VerticalAlignment = xlVAlignTop  'Vertikale Ausrichtung nach oben
    objExcel.Selection.Columns.AutoFit  'Optimale Spaltenbreite
    objExcel.Selection.Rows.AutoFit  'Optimale Zeilenhöhe
    objSheet.Range("A1").Select           
End Sub
	
	
'Formatiert ein Arbeitsblatt mit der entsprechenden Schriftart und -grösse
'Aufruf ...FormatRangeFont("Arial", 10)

Sub FormatRangeFont(strFontName As String, iFontSize As Integer)
  objSheet.Cells.Select  'Gesamtes Arbeitsblatt markieren
  objExcel.Selection.Font.Name = strFontName  'Schriftart
  objExcel.Selection.Font.Size  = iFontSize  'Zeichengrösse setzen
  objSheet.Range("A1").Select           
End Sub
	
	
' Formatiert einen Bereich mit entsprechender Breite und Zeilenumbruch
'Aufruf ...FormatRangeWidth("A:A") für Spalte A

Sub FormatRangeWidth(sZiel As Variant)         
  objSheet.Columns(sZiel).Select
  objSheet.Columns(sZiel).ColumnWidth = 28
  objExcel.Selection.WrapText = True  'Zeilenumbruch zulassen
  objSheet.Range("A1").Select 
End Sub

Axel

[ata]

... Es kann manchmal performanter sein, eine Text-Datei nach Excel zu importieren, als mühsam alle Zeilen und Spalten "zu Fuß mit der Hand am Arm" zu befüllen...


' # als Beispiel eine Textdatei mit 6 Spalten
Dim vDataTypes( 0 to 5 ) As Integer
vDataTypes( 0 ) = 1    ' # 1. Spalte automatisch - implizit
vDataTypes( 1 ) = 2    ' # 2. Spalte als Text
vDataTYpes( 2 ) = 4    ' # 3. Spalte als Datum-Zeit-Wert => t.m.j
vDataTypes( 3 ) = 2    ' # 4. Spalte als Text
vDataTypes( 4 ) = 9    ' # 5. Spalte nicht importieren
vDataTypes( 5 ) = 1    ' # 6. Spalte automatisch

Call xlDataImport( xlSheet , "C:\Temp\Test.csv" , ";" , vDataTypes , "A1" )

Code

Function xlDataImport( xlSheet As Variant , sFilePath As String , sSep As String , vDataTypes As Variant , sStartPos As String) As Variant
   ' # importieren einer ASCII-Datei nach Excel
   ' # xlSheet => Variant => Arbeitsblatt als Excel-Objekt
   ' # sFilePath => String => vollständiger Pfad der zu importierenden Text-Datei
   ' # sSep => String => Separator, mit dem die Daten voneinander getrennt sind
   ' # vDataTypes => String-Array => Alias der Datentypen für die importierten Spalten - erster Wert = erste Spalte
   ' # sStartPos => String => z.B. "A1" für die erste Zelle in der ersten Spalte
   '
    With xlSheet.QueryTables.Add( "TEXT;" & sFilePath, xlSheet.Range( sStartPos ))
        .Name = "Adressen"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = 1 ' xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252 ' # Windows Ansi
        .TextFileStartRow = 1
        .TextFileParseType = 1 ' xlDelimited
        .TextFileTextQualifier = -4142 ' xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = sSep
        .TextFileColumnDataTypes = vDataTypes
        .TextFileTrailingMinusNumbers = True
        .Refresh False
    End With
   '
End Function

[MadMetzger]

Ist es nicht sinnvoll, diesen Code in eine Klasse in einer SkriptLib zu verpacken, im initialize der Bibliothek eine globale Variable mit einem Objekt der Klasse zu besetzen und im terminate den Destruktor delete auf diesem Objekt wieder aufzurufen. So würde man unterbinden, dass dieses vergessen wird.

[ata]

@Axel

... ich habe mir die Codeschnipsel von dir angesehen, ich nehm mir die mal als Baumaterial für die nächsten Funktionen - OK ?

Aus Gründen der Performance versuche ich so weit es geht auf Selection zu verzichten, da dies immer ziemlich auf die Geschwindigkeit geht...

Toni

[ata]

@Markus,

... mal schaun, was daraus mal wird. Mein Ziel ist es erstmal die verschiedensten Schnipsel zu sammeln und vorzutragen. Der Code von Axel ist zunächst nicht lauffähig, da er globale Variablen verwendet - die Funktionen sind lauffähig, sie benötigen lediglich die richtigen Parameter bei deren Übergabe...

Aus Gründen der Performance versuche ich die Lib's so klein wie möglich zu halten, um nicht einen Riesen-Ballast zu laden, den ich dann gar nicht jedes Mal komplett brauche. Daher schwebt mir ein gestaffelter Aufbau von Lib's vor

Library Excel_Fundamentals => mit GetExcel, CloseExcel, ShowExcel, HideExcel...
Library Excel_Save => mit Speicherfunktionalitäten, Export aus Excel nach ASCII etc...
Library Excel_Import => Import-Funktionen
Library Excel_Formating => mit Funktionen zur Formatierung
Library Excel_Sort => verschiedene Sortierfunktionen
...

... so in der Art ungefähr...

Toni

[Axel]

@Axel

... ich habe mir die Codeschnipsel von dir angesehen, ich nehm mir die mal als Baumaterial für die nächsten Funktionen - OK ?

Aber na klar doch.


Axel

[Axel]

@Markus,

... mal schaun, was daraus mal wird. Mein Ziel ist es erstmal die verschiedensten Schnipsel zu sammeln und vorzutragen. Der Code von Axel ist zunächst nicht lauffähig, da er globale Variablen verwendet -
...

Richtig. Da kommt daher, dass der Code aus verschiedenen Versionen einer Klasse herauskopiert wurden.

Wenn sie losgelöst eingesetzt werden sollen, ist noch etwas Handarbeit notwendig.


Axel

[ata]

Eine Excel-Anwendung verbergen oder anzeigen

... nach einem Export anzeigen

Call xlShow( xl , True )


... eine geöffnete Excel-Anwendung unsichtbar schalten, zum Beispiel um über LotusScript einen Eingabedialog sichtbar zu machen...

Call xlShow( False )

Code

Sub xlShow( xl As Variant , bVisible As Variant )
   ' # Excel sichtbar oder unsichtbar machen.
   ' # xl => Variant => Excel-Anwendung
   ' # bVisible => Variant => True für Anzeigen, false für Verbergen
   '
   xl.Visible = bVisible
   ' 
End Sub	

[ata]

... mehrere Zellen eines Arbeitsblatts miteinander verbinden...

Ein Aufruf kann wie folgt aussehen:
Call xlMergeCells( xlSheet , "A3:D5" ) ' # verbindet im Sheet die Zellen des Bereiches zu einer Zelle

Code

Function xlMergeCells( xlSheet As Variant , sRange As String ) As Variant
   ' # Excel-Zellen eines Bereiches miteinander verbinden.
   ' # xlSheet => Variant => Excel-Arbeitsblatt
   ' # sRange => String => z.B. "A3:D5"
   '
   xlSheet.Range( sRange ).Merge
   '
End Function

[ata]

... Spalten in der Breite formatieren

z.B. Die ersten drei Spalten und die 5. Spalte...
   Call SetExcelColumnWidth( xlSheet , "A:C" , 24.05 )
   Call SetExcelColumnWidth( xlSheet , 5 , 24.05 )

Code

Function SetExcelColumnWidth( xlSheet As Variant , vRange As Variant , vColWidth As Variant )
   ' # Excel-Spalten auf eine bestimmte Breite formatieren.
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # vRange => Variant => z.B. "A:C" für die ersten 3 Spalten und die 5.
   ' # vColWidth => Variant => gewünschte Breite der Spalte => z.B. 5.05
   '
   xlSheet.Columns( vRange ).ColumnWidth = vColWidth
   '
End Function

[ata]

... Excel-Zellen farbig hervorheben...

Es gibt in Excel die Zahlen 0 - 56 für Farbwerte
0 = keine Farbe
1 = schwarz
2 = weiß
3 = rot
...

Ich habe mir eine Hilfstabelle gebaut, in der alle Farben aufgeführt sind...

z.B.
Call SetExcelCellColor( xlSheet , "A1:D5" , 3 , 2 ) ' # Hintergrund rot, Schriftfabe weiß

Code

Function SetExcelCellColor( xlSheet As Variant , sRange As String , iColBG As Integer , iColText As Integer ) As Variant
   ' # Die Text- und Hintergrundfarbe eines Bereichs in Excel bestimmen
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # sRange => String => z.B. "A1:E5" für die ersten 5 Zeilen der Spalten A bis E
   ' # iColBG As Integer
   ' # iColText As Integer
   '
   xlSheet.Range( sRange ).Interior.ColorIndex = iColBG
   xlSheet.Range( sRange ).Font.ColorIndex = iColText
   '
End Function

[ata]

... aus den bisherigen Funktionen habe ich eine dynamische Funktion zur Höhe und Breite von Spalten / Reihen gebastelt...

Ein Aufruf kann wie folgt aussehen:
Call xlFitRange( xl , xlSheet , "" , "" ) ' # Autofit des gesammten Arbeitsblattes => geht über Select des Arbeitsblattes
Call xlFitRange( xl , xlSheet , "B1:E4" , "" ) ' # Autofit Spalten "B" bis "E" und angepasste Höhe bei Zeilen "1" bis "4"
Call xlFitRange( xl , xlSheet , "B1:E1" , "50 x 40" ) ' # Spalten "B" bis "E" mit Breite "50" und nur Zeile 1 mit einer Höhe von "40"

Hinweis:
Maßangaben können unterschiedliche Auswirkungen haben, je nach Ländereinstellungen, daher sollten nur Ganzzahlen verwendet werden.
Die verschiedenen Excel-Versionen kennen unterschiedlich viele Spalten und Zeilen. Die Begrenzung auf 256 Spalten "IV" und 65536 Zeilen pro Arbeitsblatt muß je nach Excel-Version extra validiert werden.

Code

Function xlFitRange( xl As Variant , xlSheet As Variant , vRange As Variant , vParam As Variant )
   ' # Bestimmte Excel-Bereiche auf Breite und Höhe formatieren.
   ' # xlSheet => Variant => das Excel-Arbeitsblatt
   ' # vRange => Variant => z.B. "A:E" für die ersten 5 Spalten
   ' # vParam => Variant => gewünschte Formatierung des Bereiches "Breite x Höhe" => z.B. "50,05x20,5" ( 0 = Spalte verbergen, bei Leerstring Autofit )
   '
   On Error GoTo GeneralError
   '
   Dim vWidth As Variant
   Dim vHeight As Variant
   Dim vRangeColumn As Variant
   Dim vRangeRow As Variant
   Dim vValue As Variant
   Dim i As Integer
   Dim sValue As String
   Dim sMsg As String
   '
   ' # Parsen der Parameter
   ' # ... Breite und Höhe
   If Instr( Cstr( vParam ) , "x" ) > 0 Then
      vValue = Split( Trim(Cstr(vParam)) , "x" )
      vWidth =  Trim(Cstr(vValue(0))) 
      vHeight =  Trim(Cstr(vValue(1))) 
   Else
      vWidth = Cstr( vParam )
      vHeight = Cstr( vParam )
   End If
   ' # ... Bereich
   If Instr( Trim(Cstr(vRange)) , ":" ) Then
      vValue = Split( Trim(Cstr( vRange )) , ":" )
      ' # Spalte von Reihe trennen
      For i = 1 to len( vValue( 0 ) )
         sValue = Mid$( vValue( 0 ) , i , 1 )
         If IsNumeric( sValue ) Then
            vRangeRow = vRangeRow + sValue
         Else
            vRangeColumn = vRangeColumn + sValue
         End If
      Next
      '
      If vRangeColumn <> "" Then vRangeColumn = vRangeColumn & ":"
      If vRangeRow <> "" Then vRangeRow = vRangeRow & ":"
      '
      For i = 1 to len( vValue( 1 ) )
         sValue = Mid$( vValue( 1 ) , i , 1 )
         If IsNumeric( sValue ) Then
            vRangeRow = vRangeRow + sValue
         Else
            vRangeColumn = vRangeColumn + sValue
         End If
      Next
      '
   Else
      For i = 1 to len( vRange )
         sValue = Mid$( vRange , i , 1 )
         If IsNumeric( sValue ) Then
            vRangeRow = vRangeRow + sValue
         Else
            vRangeColumn = vRangeColumn + sValue
         End If
      Next
      If vRangeColumn <> "" Then vRangeColumn = vRangeColumn & ":" & vRangeColumn
      If vRangeRow <> "" Then vRangeRow = vRangeRow & ":" & vRangeRow
   End If
   '
   ' # Formatieren des Bereiches nach Breite und Höhe
   If Trim(Cstr( vRange )) = "" Then
      xlSheet.Cells.Select
      xl.Selection.Columns.AutoFit
      xl.Selection.Rows.AutoFit
      xlSheet.Range( "A1" ).Select    
   Else
      If Lcase(Cstr( vParam )) = "" Then
         If vRangeColumn <> "" Then xlSheet.Columns( vRangeColumn ).AutoFit
         If vRangeRow <> "" Then xlSheet.Rows( vRangeRow ).AutoFit
      Else
         If vRangeColumn <> "" Then xlSheet.Columns( vRangeColumn ).ColumnWidth = Cdbl( vWidth )
         If vRangeRow <> "" Then xlSheet.Rows( vRangeRow ).RowHeight = Cdbl( vHeight )
      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 & "Bereich = " & Cstr( vRange ) & Chr(10)
    sMsg = sMsg & "Maßangaben = " & Cstr( vParam ) & Chr(10)
    sMsg = sMsg & "Spaltenbreite = " & Cstr( vWidth ) & Chr(10)
    sMsg = sMsg & "Reihenhöhe = " & Cstr( vHeight ) & Chr(10)
    sMsg = sMsg & "Bereich Spalten = " & Cstr( vRangeColumn ) & Chr(10)
    sMsg = sMsg & "Bereich Reihen = " & Cstr( vRangeRow ) & 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, Zeilen- und Reihenangaben müssen plausibel sein." & Chr(10)
       sMsg = sMsg & ""
    Elseif err = 213 And ( Instr( Error , "ColumnWidth" ) > 0 Or  Instr( Error , "RowHeight" ) > 0 ) Then
       sMsg = sMsg & Chr(10) & Chr(10)
       sMsg = sMsg & "Hinweis: " & Chr(10) & "Die Maßangaben müssen dem lokalen Zahlenformat entsprechen." & Chr(10)
       sMsg = sMsg & "Das Zahlenformat für Breite oder Höhe kann vermutlich nicht interprteiert werden."
    End If
    MsgBox sMsg  , 16 ,  "Fehler in Funktion xlFitRange()"
    xl.Visible = True
    Resume Next
End Function