ExcelFunktionen PureDisphelper
- Falko
- Admin
- Beiträge: 3531
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.0 - Kontaktdaten:
Ich habe im obigen Source, dank Hilfe von Kiffi, noch weitere
Funktionen wie färben von Zellen, markieren von Zellen direkt bzw. rechts
von der selektierten Zelle und Liniengitter ein bzw. ausschalten
hinzufügen können.
Ich hoffe ihr könnt es vielleicht auch gebrauchen.
Nochmals Dank an Kiffi.
Gruß Falko
Funktionen wie färben von Zellen, markieren von Zellen direkt bzw. rechts
von der selektierten Zelle und Liniengitter ein bzw. ausschalten
hinzufügen können.
Ich hoffe ihr könnt es vielleicht auch gebrauchen.
Nochmals Dank an Kiffi.
Gruß Falko
Es wird problematisch, da ADODB nicht über die Befehlreferenz von Excel verfügt. Daher die Möglichkeit z. B. SetColor, PageSetup u.s.w. fehlen. Datenzugriff ist jedoch möglich, aber ziemlich eingeschränkt.mk-soft hat geschrieben:Schöne sache
Vielleicht hat jemand lust diese mit adodb und DispHelper zu realisieren.
Dann läuft es auch, ohne das Excel installiert wurde.
FF
Ich habe die Code von Kiffi etwas modifiziert:
Code: Alles auswählen
; example by Kiffi
;modified by eleowal
EnableExplicit
Declare DatenAendern(oRS, Feld.s, Wert.s)
Global Databasename.s = "C:\MeineDatei.xls"
XIncludeFile "adoconstants.pbi"
dhToggleExceptions(#True)
Procedure ADOX_Example_Create_New_Database_Append_Tables_And_Columns()
If FileSize(Databasename) > 0
If DeleteFile(Databasename) = 0
ProcedureReturn
EndIf
EndIf
Protected oCatalog.l
Protected oTable.l
Protected oColumn.l
Protected ConnectionString.s
; Create the required ADOX-Object
oCatalog = dhCreateObject("ADOX.Catalog")
If oCatalog = 0
MessageRequester("ADOX-Example", "Couldn't create ADOX.Catalog")
ProcedureReturn
EndIf
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
dhPutValue(oCatalog,".ActiveConnection = %T",@ConnectionString)
;die Methode Catalog.Create(....) funktioniert bei Excel nicht. Man muss zuerst mindestens
;eine Tabelle und mindestens eine Spalte anlegen.
; Create a new table
oTable = dhCreateObject("ADOX.Table")
If oTable = 0
MessageRequester("ADOX-Example", "Couldn't create table")
dhReleaseObject(oCatalog)
ProcedureReturn
EndIf
; give the table a name
dhPutValue(oTable, ".Name = %T", @"TestTable")
;
; ; Create an ID-Column with Autoincrement (das läuft nicht....)
oColumn = dhCreateObject("ADOX.Column")
dhPutValue(oColumn, ".ParentCatalog = %o", oCatalog)
dhPutValue(oColumn, ".Name = %T", @"ID")
dhPutValue(oColumn, ".Type = %d", #adInteger)
; dhPutValue(oColumn, ".Properties(%T) = %b", @"Autoincrement", #True)
;
; ; Append the new column to the table
dhCallMethod(oTable, ".Columns.Append(%o)", oColumn)
;
; ; Create and append some more Columns
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"IntegerField", #adInteger)
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"TextField", #adVarWChar)
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"MemoField", #adLongVarWChar)
;
; Append table to catalog
dhCallMethod(oCatalog, ".Tables.Append(%o)", oTable)
;andere Möglichkeit existiert auch und ist wesentlich schneller....
Protected sql.s = "CREATE TABLE test(id int, name char(30), vorname char(30));"
Protected oCN.l
Protected i.l
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADOX-Example", "Couldn't create ADODB.Connection")
ProcedureReturn
EndIf
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
dhCallMethod(oCN, ".Execute(%T)", @sql)
For i = 1 To 100
sql = "Insert into [test$](id, name, vorname) VALUES(" + Str(i) + ", 'Nachname " + Str(i) + "', 'Vorname " + Str(i)+ "');"
dhCallMethod(oCN, ".Execute(%T)", @sql)
Next
dhCallMethod(oCN,".Close")
EndIf
;
dhReleaseObject(oColumn)
dhReleaseObject(oTable)
dhReleaseObject(oCatalog)
dhReleaseObject(oCN)
MessageRequester("ADOX-Example", "Ready. Database successfully created.")
EndProcedure
Procedure ADO_Example_Open_Existing_Table_And_Fill_In_Some_Data()
Protected oCN.l ; Connection-Object
Protected ConnectionString.s
Protected SQL.s
Protected Counter.l
; Connection string.
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
; Create the required ADO-Connection-Object
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADOX-Example", "Couldn't create ADODB.Connection")
ProcedureReturn
EndIf
; Open the connection.
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
; Insert some records.
For Counter = 0 To 99
SQL = "Insert Into TestTable (IntegerField, TextField, MemoField) Values (" + Str(Counter) + ", 'Text" + Str(Counter) + "', 'Memo" + Str(Counter) + "')"
dhCallMethod(oCN, ".Execute(%T)", @SQL)
Next
; Close the connection.
dhCallMethod(oCN, ".Close")
MessageRequester("ADOX-Example", "Ready. Database successfully filled with sample-data.")
Else
MessageRequester("ADOX-Example", "Couldn't open the Connection")
EndIf
dhReleaseObject(oCN)
EndProcedure
Procedure ADO_Example_Open_Existing_Table_And_Read_Data()
Shared oRS.l ; Connection-Object
Protected oCN.l ; Connection-Object
Protected szResponse.l
Protected ConnectionString.s
Protected SQL.s
Protected EOF.l
; Connection string.
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
; Create the required ADO-Connection-Object
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADO", "Couldn't create Connection-Object")
ProcedureReturn
EndIf
; Open the connection.
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
; Retrieve some records.from Range A1:D10
SQL = "Select * from [TestTable$A1:D10]"
oRS = dhCreateObject("ADODB.Recordset")
If oRS = 0
MessageRequester("ADO", "Kann Recordset nicht erstellen")
ProcedureReturn
EndIf
dhPutValue(oRS,".ActiveConnection = %o",oCN)
dhPutValue(oRS,".LockType = %d", 2)
dhPutValue(oRS,".Source = %T", @SQL)
dhCallMethod(oRS,".Open")
;gehe zu Ende
dhCallMethod(oRS,".MoveLast")
;
;mann kann die Daten aendern...
DatenAendern(oRS, "MemoField", "Das ist die letzte Memo")
DatenAendern(oRS, "TextField","Das ist der letzter Datensatz")
;gehe zu DS 5
dhCallMethod(oRS,".MoveFirst")
dhCallMethod(oRS,".Move %d",5)
DatenAendern(oRS, "MemoField", "Das ist die Memo Nr. 5")
DatenAendern(oRS, "TextField","Das ist der Text Nr. 5")
;und wieder zum Anfang
dhCallMethod(oRS,".MoveFirst")
;
;mann kann die Daten aendern...
DatenAendern(oRS, "MemoField", "Noch einen Wert, den ich will....")
DatenAendern(oRS, "TextField","Hier ist mein Text...")
Repeat
dhGetValue("%b", @EOF, oRS, ".EOF")
If EOF
Break
EndIf
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"IntegerField")
If szResponse : Debug "IntegerField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"TextField")
If szResponse : Debug "TextField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"MemoField")
If szResponse : Debug "MemoField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
Debug "-------"
dhCallMethod(oRS, ".MoveNext")
ForEver
; Close and release the recordset.
dhCallMethod(oRS, ".Close")
dhReleaseObject(oRS)
; Close and release the connection.
dhCallMethod(oCN, ".Close")
dhReleaseObject(oCN)
EndIf
EndProcedure
Procedure DatenAendern(oRS, Feld.s, Wert.s)
dhPutValue(oRS,".Fields(%T).Value = %T",@Feld, @Wert)
dhCallMethod(oRS,".Update")
EndProcedure
ADOX_Example_Create_New_Database_Append_Tables_And_Columns()
ADO_Example_Open_Existing_Table_And_Fill_In_Some_Data()
ADO_Example_Open_Existing_Table_And_Read_Data()
End
- Falko
- Admin
- Beiträge: 3531
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.0 - Kontaktdaten:
Super, das mit der Datenbank
Kiffi hat mir mit seinem Beispiel für SetBorder wiedermal weiter geholfen ,
woraus ich nun zwei Funktionen für die ExcelDemo (Siehe Anfangs-Thread)
eingebaut habe (SetBorder() und. EraseBorder() ).
Damit müssten die wichtigsten Funktionen zur ferngesteuerten
Excelbearbeitung vorhanden sein
Kompletter Source am Anfang vom Thread ersetzt.
Gruß Falko
Kiffi hat mir mit seinem Beispiel für SetBorder wiedermal weiter geholfen ,
woraus ich nun zwei Funktionen für die ExcelDemo (Siehe Anfangs-Thread)
eingebaut habe (SetBorder() und. EraseBorder() ).
Damit müssten die wichtigsten Funktionen zur ferngesteuerten
Excelbearbeitung vorhanden sein
Kompletter Source am Anfang vom Thread ersetzt.
Gruß Falko
- Falko
- Admin
- Beiträge: 3531
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.0 - Kontaktdaten:
Folgende Funktionen und Beispiele wurden
oben in der ExcelDemo.pb hinzugefügt!
04.08.2007
ColorOff() ; Farbige Zellen verschwinden lassen
MergeCells() ; Zellen verbinden bzw. Verbindung wieder aufheben
InsertRow() ; Zeile einfügen und wieder entfernen
InsertColumn();Spalte einfügen und wieder entfernen
InsertCell() ; Zelle einfügen mit verschieben nach rechts oder nach unten
DeleteCell(); Zelle entfernen mit verschieben nach links oder nach oben
04.08.2007
Procedure Pattern() ; Setzen und entfernen von Mustern in einzelne oder mehrere Zellen
Es kann durchaus sein, das Fehlermeldungen des
PureDisphelpers auftauchen, da ich wegen Excel 2007 das nicht feststellen
konnte.
Folglich müssen dann für ältere Excelversionen die entsprechenden
Konstanten bzw. Funktionsaufrufe entfernt werden, falls an dieser Stelle ein
Fehler auftaucht
das nicht nachprüfen kann. Bitte schreibt mir
Gruß Falko
oben in der ExcelDemo.pb hinzugefügt!
04.08.2007
ColorOff() ; Farbige Zellen verschwinden lassen
MergeCells() ; Zellen verbinden bzw. Verbindung wieder aufheben
InsertRow() ; Zeile einfügen und wieder entfernen
InsertColumn();Spalte einfügen und wieder entfernen
InsertCell() ; Zelle einfügen mit verschieben nach rechts oder nach unten
DeleteCell(); Zelle entfernen mit verschieben nach links oder nach oben
04.08.2007
Procedure Pattern() ; Setzen und entfernen von Mustern in einzelne oder mehrere Zellen
Es kann durchaus sein, das Fehlermeldungen des
PureDisphelpers auftauchen, da ich wegen Excel 2007 das nicht feststellen
konnte.
Folglich müssen dann für ältere Excelversionen die entsprechenden
Konstanten bzw. Funktionsaufrufe entfernt werden, falls an dieser Stelle ein
Fehler auftaucht
das nicht nachprüfen kann. Bitte schreibt mir
Gruß Falko
- Thorsten1867
- Beiträge: 1359
- Registriert: 04.02.2005 15:40
- Computerausstattung: [Windows 10 x64] [PB V5.7x]
- Wohnort: Kaufbeuren
- Kontaktdaten:
Würde es gerne ausprobieren. Leider fehlt die Datei bzw. der Code:eleowal hat geschrieben:Es wird problematisch, da ADODB nicht über die Befehlreferenz von Excel verfügt. Daher die Möglichkeit z. B. SetColor, PageSetup u.s.w. fehlen. Datenzugriff ist jedoch möglich, aber ziemlich eingeschränkt.
Code: Alles auswählen
XIncludeFile "adoconstants.pbi"
- ts-soft
- Beiträge: 22292
- Registriert: 08.09.2004 00:57
- Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel - Wohnort: Berlin
...\Examples\PureDispHelper\ado\adoconstants.pbi
Ist im Paket. Ansonsten befindet sich die entsprechende VB Version auch auf
Deiner Festplatte, einfach suchen.
Ist im Paket. Ansonsten befindet sich die entsprechende VB Version auch auf
Deiner Festplatte, einfach suchen.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
- Thorsten1867
- Beiträge: 1359
- Registriert: 04.02.2005 15:40
- Computerausstattung: [Windows 10 x64] [PB V5.7x]
- Wohnort: Kaufbeuren
- Kontaktdaten:
- ts-soft
- Beiträge: 22292
- Registriert: 08.09.2004 00:57
- Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel - Wohnort: Berlin
Bedank Dich bei Kiffi. der hat die VBS-Datei gepatcht und ist sowieso der Ado-MannThorsten1867 hat geschrieben:Danke!
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
hier noch eine kleine Ergänzung zu Falkos Code:
Zeichensatz und -größe ändern
Grüße ... Kiffi
Zeichensatz und -größe ändern
Code: Alles auswählen
Procedure SetFont(*obj, RangeStart.s, RangeEnd.s, FontName.s, FontSize.l) ; Set font in Cells
Protected Range.s = RangeStart + ":" + RangeEnd
dhCallMethod(*obj, ".Range(%T).Select", @Range)
dhPutValue (*obj, ".Selection.Font.Name = %T", @FontName)
dhPutValue (*obj, ".Selection.Font.Size = %d", FontSize)
EndProcedure
Hygge
- Falko
- Admin
- Beiträge: 3531
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.0 - Kontaktdaten:
Danke Kiffi
Ich habe auch noch was mit Bilder einfügen gemacht. Nur funktioniert es
nicht mit der Zellposition. Vielleicht habt ihr ja noch eine passende Lösung
parat
Gruß, Falko
Ich habe auch noch was mit Bilder einfügen gemacht. Nur funktioniert es
nicht mit der Zellposition. Vielleicht habt ihr ja noch eine passende Lösung
parat
Code: Alles auswählen
Procedure PutImage(*obj, Range.s,Picture.s) ; Insert Pictures with Cellposition
dhCallMethod(*obj,"Range(%T).Select",@Range)
dhCallMethod(*obj,"ActiveSheet.Pictures.Insert(%T).Select",@Picture)
dhPutValue(*obj,"ActiveSheet.Pictures.ShapeRange.Height=%d",50);Höhe Bild
dhPutValue(*obj,"ActiveSheet.Pictures.ShapeRange.Rotation=%d",90);Bild drehen
dhPutValue(*obj,"ActiveSheet.Pictures.ShapeRange.Left=%d",200);Bild um 200 Pixel nach rechts verschieben
dhCallMethod(*obj,"Range(%T).Select",@"A1") ; Select Cell A1
Delay(10000)
dhCallMethod(*obj,"ActiveSheet.Pictures.Delete") ; Test
EndProcedure
PutImage(ExcelApp, "F1" ,"C:\MyImage\MeinBild.jpg")
Gruß, Falko