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
'--- 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
... 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
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
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
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
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
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
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" )
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
'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
... 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" )
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
... 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 )
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
Ein Aufruf kann wie folgt aussehen:
Call xlMergeCells( xlSheet , "A3:D5" ) ' # verbindet im Sheet die Zellen des Bereiches zu einer Zelle
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
z.B. Die ersten drei Spalten und die 5. Spalte...
Call SetExcelColumnWidth( xlSheet , "A:C" , 24.05 )
Call SetExcelColumnWidth( xlSheet , 5 , 24.05 )
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
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ß
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
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.
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
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.
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
Ein Aufruf kann wie folgt aussehen:
' # 5. Zeile für den Autofilter aktivieren
Call xlAutoFilter( xlSheet , 5 )
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
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
Eine Verwendung kann wie folgt aussehen:
Dim vColName As Variant
vColName = xlGetColumnNames( )
Print "Die fünfte Spalte hat den Buchstaben " & vColName( 5 )
Function xlGetColumnNames( ) As Variant
' # übergibt die möglichen 256 Excel-Spalten-Namen als Array
Dim vCol As Variant
Dim sDummy( 0 ) As String
vCol = Evaluate( |vA := "A":"B":"C":"D":"E":"F":"G":"H":"I":"J":"K":"L":"M":"N":"O":"P":"Q":"R":"S":"T":"U":"V":"W":"X":"Y":"Z";@Subset(("" :vA) *+ vA;256)|)
xlGetColumnNames = ArrayAppend( sDummy , vCol )
End Function
Eine Verwendung kann wie folgt aussehen:
Call xlSaveAs( xlWbk , "C:\Temp\demo.xls" )
Function xlSaveAs( xlWbk As Variant , sFilePath As String ) As Variant
If sFilePath <> "" Then Call xlWbk.SaveAs( sFilePath )
End Function
'#######################
' Seiteneinstellungen
'#######################
With xl.ActiveSheet.PageSetup
'Variablen
'&A - Gesamtseitenzahl
'&B - Blattname
'&D - Datum
'&I - Bild
'&N - Dateiname
'&P - Speicherort
'&S - Seite
'&U - Uhrzeit
.Orientation = 2
.LeftHeader = ""
.CenterHeader = "&""Arial,Bold""&18"+db.Title
.RightHeader = ""
.LeftFooter = "&""Arial""&8&P-&N"
.CenterFooter = "&""Arial""&8Seite &S von &A"
.RightFooter = "&""Arial""&8&D - &U"
.PrintArea = ("A1:H5")
.PaperSize = 9
.CenterHorizontally = True
.FitToPagesTall =False
.zoom = False
.FitToPagesWide=1
.PrintTitleRows=xl.Rows("1:1").Address
End With
Was mir noch nicht gelingen will, ist der Zeilenumbruch innerhalb eines Feldes, z.B. CenterFooter, aber wahrscheinlich bin ich nur zu müde.
Der Excel-Makrorekorder nimmt chr(10), gebe ich das aus LN mit, kommt es als Text an.
Hallo zusammen
Wäre besser Select zu vermeiden (nur verwenden wo wirklich was angesprungen werden muss). Vorteile sind dabei es wird schneller und nerviges rumgehüpfe verschwindet.
Zum Beispiel besser so:
With objSheet.Cells
.Columns.AutoFit
.Rows.AutoFit
End With
Als:
objSheet.Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Gruss
Remo