Hallo Peter!
Danke für Dein Hilfsangebot.
Hier die beiden Prozeduren zum Erzeugen und Einlesen einer (geschützten) Tabelle:
Code: Alles auswählen
XIncludeFile "...\COMmate\ExcelFunctions.pbi" ; hier aktuellen Pfad setzen
EnableExplicit
Procedure MakeEmptyXLS()
Debug "Enter MakeEmptyXLS()"
Protected.COMateObject ExcelObject, WorkBook, ActiveSheet
Protected XLSPath.s, Datei.s, Range.s, pw.s
Datei.s=GetPathPart(ProgramFilename())+"Neu.xls"
Debug Datei
Datei.s=SaveFileRequester("Leere Excel-Datei erstellen...", Datei, "Excel-Datei (*.xls)|*.xls", 0)
If Datei<>""
If FileSize(Datei)>-1
If MessageRequester("Achtung!",
"Die Datei '"+GetFilePart(Datei)+"' existiert bereits."+#CRLF$+#CRLF$+"Soll sie überschrieben werden?",
#PB_MessageRequester_YesNo|#MB_ICONQUESTION)=#PB_MessageRequester_No
ProcedureReturn
EndIf
EndIf
XLSPath=GetPathPart(Datei)
ExcelObject = COMate_CreateObject("Excel.Application")
If ExcelObject
ExcelObject\SetProperty("Visible = #false") ; Excel im Hintergrund. Kann man nur im Taskmanager sehen
WorkBook = ExcelObject\GetObjectProperty("Workbooks\Add") ; fügt eine Tabelle hinzu
ExcelObject\SetProperty("WorkSheets(1)\Name = 'Tabelle 1'") ; Tabelle1 mit Namen verzeichnen
ExcelObject\SetProperty("WorkSheets(2)\Name = 'Tabelle 2'") ; Tabelle1 mit Namen verzeichnen
ExcelObject\SetProperty("WorkSheets(3)\Name = 'Tabelle 3'") ; Tabelle1 mit Namen verzeichnen
XLSFunc_DeleteWorksheet(ExcelObject.COMateObject,"Tabelle 2") ; Tabellenblatt 2 löschen
XLSFunc_DeleteWorksheet(ExcelObject.COMateObject,"Tabelle 3") ; Tabellenblatt 3 löschen
Debug "Delete Sheets 2 and 3: "+comate_getlasterrordescription()
XLSFunc_SetCellFormat(ExcelObject, "A:H", "@") ; Spalten "Kopf 1" bis "Kopf 5" als Text formatieren
XLSFunc_SetCellFormat(ExcelObject, "F:F", "000000000") ; Spalte "Kopf 6" als Zahl mit neun Stellen und führender Null
XLSFunc_SetCellFormat(ExcelObject, "1:1", "@") ; Kopfzeile als Text formatieren
Debug "Set Format: "+comate_getlasterrordescription()
XLSFunc_SetFontAlignment(ExcelObject, "E:G",#xlHAlignCenter) ; Spalte "Kopf 5" zentrieren
XLSFunc_SetFontAlignment(ExcelObject, "1:1",#xlHAlignCenter) ; Spalte "Kopf 6" zentrieren
Debug "Align : "+comate_getlasterrordescription()
ExcelObject\SetProperty("Cells(1,1) = 'Kopf 1'") ; Header "Kopf 1"
ExcelObject\SetProperty("Cells(1,2) = 'Kopf 2'") ; Header "Kopf 2"
ExcelObject\SetProperty("Cells(1,3) = 'Kopf 3'") ; Header "Kopf 3"
ExcelObject\SetProperty("Cells(1,4) = 'Kopf 4'") ; Header "Kopf 4"
ExcelObject\SetProperty("Cells(1,5) = 'Kopf 5'") ; Header "Kopf 5"
ExcelObject\SetProperty("Cells(1,6) = 'Kopf 6'") ; Header "Kopf 6"
ExcelObject\SetProperty("Cells(1,7) = 'Kopf 7'") ; Header "Kopf 7"
ExcelObject\SetProperty("Cells(1,8) = 'Kopf 8'") ; Header "Kopf 8"
Debug "Set title text: "+comate_getlasterrordescription()
XLSFunc_LockFirstLine(ExcelObject, "A2") ; Kopfzeile soll nicht scrollen
Debug "Lock: "+comate_getlasterrordescription()
; Sub Makro1()
; '
; ' Makro1 Makro
; ' Makro am 02.12.2015 aufgezeichnet
; '
; ' Tastenkombination: Strg+s
; '
; Columns("A:H").Select
; Selection.Locked = False
; Selection.FormulaHidden = False
; Range("A1:H1").Select
; Selection.Locked = True
; Selection.FormulaHidden = False
; Range("A2").Select
; ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
; End Sub
Range= "A:IV" ; Gesamtes Blatt entsperren
ExcelObject\Invoke("Range('" +Range+ "')\Select" )
Debug "Set Range A:H: "+comate_getlasterrordescription()
ExcelObject\setproperty("Selection\Locked = #False")
Debug "Set Locked = #False: "+comate_getlasterrordescription()
; ExcelObject\setproperty("Selection\FormulaHidden = #False") ; nicht benötigt
; Debug "Set FormulaHidden = #False: "+comate_getlasterrordescription()
;
Range= "A1:H1" ; Zellen der Kopfeinträge auswählen...
ExcelObject\Invoke("Range('" +Range+ "')\Select" )
Debug "Set Range A1:H1: "+comate_getlasterrordescription()
ExcelObject\setproperty("Selection\Locked = #True") ; und sperren
Debug "Set Locked = #True: "+comate_getlasterrordescription()
; ExcelObject\setproperty("Selection\FormulaHidden = #False") ; nicht benötigt
; Debug "Set FormulaHidden =#False: "+comate_getlasterrordescription()
Range= "A1" ; Kosmetik: A1 ist aktuelle Zelle
ExcelObject\Invoke("Range('" +Range+ "')\Select" )
Debug "Set Range A1: "+comate_getlasterrordescription()
ActiveSheet = ExcelObject\GetObjectProperty("ActiveSheet") ; Tabellenblatt zum Sperren der Zellen auswählen
Debug "ActiveSheet: "+comate_getlasterrordescription()
If ActiveSheet
pw="Passwort" ; Passwort zum Entsperren setzen
ActiveSheet\Invoke("Protect('"+pw+"', #True, #True, #True)") ; gewählte Zellen sperren
; ActiveSheet\Invoke("Protect(#opt, #True, #True, #True)")
Debug "Protect: "+comate_getlasterrordescription()
ActiveSheet\Release() ; Tabellenblatt wieder freigeben
Debug "Release: "+comate_getlasterrordescription()
Else
Debug "No ActiveSheet"
EndIf
ExcelObject\SetProperty("Application\DisplayAlerts = #False") ; Excel-Alerts vor dem Speichern und Beenden ausschalten
Debug "Set DisplayAlerts = #False: "+comate_getlasterrordescription()
ExcelObject\Invoke("ActiveWorkbook\SaveAs('"+Datei+"')") ; Dateiname
Debug "SaveAs: "+comate_getlasterrordescription()
ExcelObject\Invoke("ActiveWorkbook\Close") ; Schließe aktive Tabelle
Debug "Close ActiveWorkbook: "+comate_getlasterrordescription()
ExcelObject\Invoke("Workbooks\Close") ; Schließe Excelmappe
Debug "Close Workbooks: "+comate_getlasterrordescription()
ExcelObject\Invoke("Quit()") ; Excel beenden
Debug "Quit: "+comate_getlasterrordescription()
ExcelObject\SetProperty("Application\DisplayAlerts = #True") ; Excel-Alerts wieder aktivieren
Debug "Set DisplayAlerts = #True: "+comate_getlasterrordescription()
ExcelObject\Release() ; Objekt freigeben
Debug "Release: "+comate_getlasterrordescription()
Else
MessageRequester("Achtung!", "Excel-Datei konnte nicht erstellt werden.")
EndIf
EndIf
EndProcedure
Procedure ReadXLS()
Debug "Enter ReadXLS()"
Protected.COMateObject NewExcelObject
Protected Row.i, LastRow.i=1
Protected XLSFile.s, Zeile.s
XLSFile=GetPathPart(ProgramFilename())+"Neu.xls"
NewExcelObject=XLSFunc_OpenExcelFile(XLSFile)
Debug "NewExcelObject: "+comate_getlasterrordescription()
If NewExcelObject:Debug "NewExcelObject"
XLSFunc_ExcelVisible(NewExcelObject,#False)
Debug "Visible set to: #False: "+comate_getlasterrordescription()
If XLSFunc_GetSheetName(NewExcelObject, 1)="Tabelle 1"
Debug "GetSheetName: "+comate_getlasterrordescription()
XLSFunc_ChangeToWorksheet(NewExcelObject, "Tabelle 1")
Debug "ChangeToWorksheet: "+comate_getlasterrordescription()
LastRow=XLSFunc_GetLastRow(NewExcelObject)
Debug XLSFunc_GetLastCellFillFirst(NewExcelObject)
; Workaround für GetLastRow():
; While XLSFunc_ReadCellS(NewExcelObject, LastRow, 6)
; Debug "LastRow: "+comate_getlasterrordescription()
; LastRow+1
; Wend
; LastRow-1
Row=1
Zeile+XLSFunc_ReadCellS(NewExcelObject, Row, 1)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 2)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 3)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 4)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 5)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 6)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 7)+Chr(9)+
XLSFunc_ReadCellS(NewExcelObject, Row, 8)
Debug "ReadCell (all): "+comate_getlasterrordescription()
Debug Zeile
Else
Debug "Konnte 'Tabelle 1 nicht finden."
EndIf
XLSFunc_CloseWorkbook(NewExcelObject)
XLSFunc_CloseExcelAll(NewExcelObject)
EndIf
EndProcedure
MakeEmptyXLS()
ReadXLS()
Zeilen 159 bis 163 enthalten übrigens ein workaround für das
Ermitteln der letzten Tabellenzeile. Dieses ist aber nur für
meinen speziellen Fall gültig, da ich weiß, daß Spalte 6 ("Kopf 6")
immer in der letzten Zeile gefüllt ist.
Viel Spaß beim "wuseln".