PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

ExcelFunktionen COMatePlus

https://www.purebasic.fr/german/viewtopic.php?t=23254

Seite 7 von 18

Re: ExcelFunktionen COMatePlus

Verfasst: 25.03.2012 13:47
von LuZiF3R
funzt super, Danke

Re: ExcelFunktionen COMatePlus

Verfasst: 25.03.2012 18:28
von Falko
Das freut mich.

Gruß,
Falko

Re: ExcelFunktionen COMatePlus

Verfasst: 26.03.2012 15:51
von LuZiF3R
hab doch nochmal nen problem, wenn ich nen zweites bild(das gleich nochmal, aber an einer anderen Position) , dann verschiebt/vergrößert er auch das erste bild

Re: ExcelFunktionen COMatePlus

Verfasst: 27.03.2012 15:02
von Falko
So, nun habe ich das so, wie es soll. Ich habe die alte Funktion so belassen und
eine neue hinzugefügt, womit nun den Bildern unterschiedliche Größen und Positionen
korrekt zugefügt werden können. Bei der vorherigen Funktion werden wohl alle Bilder
mit den gleichen Einstellungen zur Breite, Höhe und Position des letzten Bildes gleichgesetzt, was man aus den VB-Programmbeispiel nicht erkennen konnte.

Die neue Funktion heißt:

Code: Alles auswählen

#msoTrue=-1
#msoFalse=0
Procedure XLSFunc_Image(ExcelObject.COMateObject,File.s,X.l,Y.l,Width.l,Height.l,Rot.l=0,Prop=#msoTrue,Trans.f=0)
  Protected pct.COMateObject,Tran.l

  If FileSize(File)>=0
    ExcelObject\Invoke("ActiveSheet\Pictures\Insert('"+File+"')\Select")
    ExcelObject\SetProperty("Selection\ShapeRange\LockAspectRatio = "+Str(Prop));msoTrue = Proportional
    ExcelObject\SetProperty("Selection\ShapeRange\Height="+Str(Height))
    ExcelObject\SetProperty("Selection\ShapeRange\Widht="+Str(Width))
    ExcelObject\SetProperty("Selection\ShapeRange\Left="+Str(X))
    ExcelObject\SetProperty("Selection\ShapeRange\Top="+Str(Y))
    If Trans>0
      Tran=#msoTrue
    Else
      Tran=#msoFalse
    EndIf
    ExcelObject\SetProperty("Selection\ShapeRange\Fill\Visible ="+Str(Tran))
    ExcelObject\SetProperty("Selection\ShapeRange\Fill\Solid")
    ExcelObject\SetProperty("Selection\ShapeRange\Fill\Transparency ="+StrF(Trans))
    ExcelObject\SetProperty("Selection\ShapeRange\Rotation ="+Str(Rot))
  Else
    MessageRequester("Achtung","Grafik nicht gefunden")
  EndIf
EndProcedure
Und der Test dazu ist folgender:

Code: Alles auswählen

XIncludeFile "ExcelFunktion.pbi"
Define NewExcelObject,UserDesktop.s
NewExcelObject=XLSFunc_CreateExcelFile(UserDesktop+"ExcelProgramm"); Create a new Excelfile to this Path.
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Autumn Leaves.jpg",100,100,200,200,180);Bildproportionen automatisch
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Creek.jpg",500,300,10,150,90,#msoFalse,0.75);Bildproportionen manuell
Debug COMate_GetLastErrorDescription() 
XLSFunc_ExcelVisible(NewExcelObject,#True); To see Excel, behind close Workbook
MessageRequester("Warnung","Excel wird bei ok geschlossen")
XLSFunc_CloseExcelAll(NewExcelObject)
Nun sollte es so funktionieren, wie du es haben wolltest. Viel Spass mit der erweiterten
ExcelFunctions.pbi :allright:

[Edit]
Bilder können nun auch rotiert werden.
Bildproportionen automatisch oder manuell
[/Edit]

//Edit2
habe noch Transparenzeinstellungen hinzugefügt.
Werte können dann von 0, ... 0.5 bis 1 dargestellt werden,
was dann 0 bis 100% entspricht.

In Excel wird das dann unter Bildeinstellungen angezeigt.
Wie man das Bild dann Transparent bekommt, muss vermutlich
mit dem Hintergrund zusammen hängen. Vielleicht kriege ich das
auch noch hin :)
//

MfG,
Falko

Re: ExcelFunktionen COMatePlus

Verfasst: 30.03.2012 20:16
von Falko
Ich nehme mal an, das man mit der letzten, aktuellen Funktion um mehrere Bilder mit unterschiedlichen
Größen und Positionen in das Excelblatt eintragen kann, so akzeptiert wurde.

Nun habe ich noch drei weitere Funktionen in der ExcelFunctions.pbi (siehe Thread-Anfang)
hinzugefügt, mit denen man Kreis, Quadrat und Linien einfügen kann.
Transparenz und Farben sind auch möglich.

Hierzu nun ein TestCode, welcher auch das Laden zweier Bilder aus Windows7, sowie Kreise, Rechteck und Linie zeigt.

Code: Alles auswählen

XIncludeFile "ExcelFunktion.pbi"
;http://www.vba-wissen.de/grafikprogrammierung.html 
Define NewExcelObject,UserDesktop.s
NewExcelObject=XLSFunc_CreateExcelFile(UserDesktop+"ExcelProgramm"); Create a new Excelfile to this Path.
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Autumn Leaves.jpg",100,100,200,200,180);Bildproportionen automatisch
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Creek.jpg",500,300,10,150,90,#msoFalse);Bildproportionen manuell
XLSFunc_Elipse(NewExcelObject,245.63, 152.33, 114.78,114.78,RGB(255,255,0),RGB(0,0,255),2,1)
XLSFunc_Elipse(NewExcelObject,245.63, 152.33+150, 114.78,114.78,RGB(255,0,255),RGB(0,0,255),2,0.5)
XLSFunc_Rectangle(NewExcelObject,445.93, 152.33, 114.78,114.78,RGB(0,255,255),RGB(0,0,255),5,0.5)
XLSFunc_Line(NewExcelObject,245.63,152.33,360.41,267.11,RGB(255,0,0),#msoLineSolid,4)
XLSFunc_Elipse(NewExcelObject,245.63-150, 152.33+40, 114.78,114.78,RGB(255,255,0),RGB(0,0,255),2,0.5)
XLSFunc_ExcelVisible(NewExcelObject,#True)
MessageRequester("Warnung","Excel wird bei ok geschlossen")
XLSFunc_CloseExcelAll(NewExcelObject)
Damit hat man einige Beispiele, wie man die Shapes einsetzen kann.
Eine schöne VBA-Seite, wo auch noch andere Funktionen wie Polygon, Pfeile, Textbox usw. gezeigt
werden können, findet ihr hier.

http://www.vba-wissen.de/grafikprogrammierung.html

Ich hoffe, das dieser Thread noch viel mehr Leute anspricht. /:->

Gruß,
Falko

Re: ExcelFunktionen COMatePlus

Verfasst: 31.03.2012 22:32
von Falko
Das Ganze nochmal zusätzlich mit der Funktion für Textbox, welche ich nun auch
in der ExcelFunctions.pbi hinzugefügt habe :wink:

Code: Alles auswählen

XIncludeFile "ExcelFunktion.pbi"
;http://www.vba-wissen.de/grafikprogrammierung.html 
Define NewExcelObject,UserDesktop.s
NewExcelObject=XLSFunc_CreateExcelFile(UserDesktop+"ExcelProgramm"); Create a new Excelfile to this Path.
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Autumn Leaves.jpg",100,100,200,200,180);Bildproportionen automatisch
XLSFunc_Image(NewExcelobject,"C:\Users\Public\Pictures\Sample Pictures\Creek.jpg",500,300,10,150,90,#msoFalse);Bildproportionen manuell
XLSFunc_Elipse(NewExcelObject,245.63, 152.33, 114.78,114.78,RGB(255,255,0),RGB(0,0,255),2,1)
XLSFunc_Elipse(NewExcelObject,245.63, 152.33+150, 114.78,114.78,RGB(255,0,255),RGB(0,0,255),2,0.5)
XLSFunc_Rectangle(NewExcelObject,445.93, 152.33, 114.78,114.78,RGB(0,255,255),RGB(0,0,255),5,0.5)
XLSFunc_Line(NewExcelObject,245.63,152.33,360.41,267.11,RGB(255,0,0),#msoLineSolid,4)
XLSFunc_Elipse(NewExcelObject,245.63-150, 152.33+40, 114.78,114.78,RGB(255,255,0),RGB(0,0,255),3,0.5)
XLSFunc_TextBox(NewExcelObject,#msoTextOrientationHorizontal,100,20,60,50,"Textfeld 1","Dies ist mein Testtext")
XLSFunc_TextBox(NewExcelObject,#msoTextOrientationHorizontal,190,20,80,40,"Textfeld 2","Und hier ein weiterer Text")
XLSFunc_ExcelVisible(NewExcelObject,#True); To see Excel, behind close Workbook
MessageRequester("Warnung","Excel wird bei ok geschlossen")
XLSFunc_CloseExcelAll(NewExcelObject)
.

Re: ExcelFunktionen COMatePlus

Verfasst: 26.04.2012 14:02
von MightyMAC
Hallo,

erst einmal danke für die Arbeit an diesem Projekt. Ich benutze die Funktionen sehr oft und bin begeistert. Eine Frage hätte ich aber dazu:

Gibt es eine (einfache) Möglichkeit eine Worksheet komplett in ein neues zu kopieren?

Gruß
Mac

Re: ExcelFunktionen COMatePlus

Verfasst: 26.04.2012 22:37
von Falko
Hallo,
meinst du so was wie in dieser VBA-Funktion?
VBA_EXCEL hat geschrieben:Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")
bzw.
VBA_EXCEL hat geschrieben:Worksheets("Sheet1").Copy Before:=Worksheets("Sheet3")
Gruß,
Falko

Re: ExcelFunktionen COMatePlus

Verfasst: 27.04.2012 04:26
von MightyMAC
Ja, genau.

Re: ExcelFunktionen COMatePlus

Verfasst: 27.04.2012 10:10
von ThoPie
Hallo Leute,
ich möchte gern per XLSFunc_AddWorksheetAfter Arbeitsblätter für alle 12 Monate anlegen. Mein Quellcode-Fragment sieht wie folgt aus:

Code: Alles auswählen

DATEI=WorkDir+"Test.xls"
ES=XLSFunc_CreateExcelFile(WorkDir)
XLSFunc_SetExcelVisible(ES,#False)
XLSFunc_PageSetup(ES,#xlLandscape,1,1,2.5,1)
XLSFunc_RenameActiveSheet(ES,"Jan")
XLSFunc_AddWorksheetAfter(ES,"Feb")
XLSFunc_AddWorksheetAfter(ES,"Mrz")
XLSFunc_SaveAsWorkbook(ES,DATEI)
XLSFunc_SetExcelVisible(ES,#True)
XLSFunc_CloseWorkbook(ES)
XLSFunc_CloseExcel(ES)
Beim Erstellen der Februar-Tabelle kommt immer ein Adressfehler in der Zeile
NewSheet\SetProperty("Name='"+NewSheetName+"'")
der Prozedur XLSFunc_AddWorksheetAfter.
Kann mit bitte mal jemand sagen, was ich falsch mache.
Danke schön.
Alle Zeiten sind UTC+02:00
Seite 7 von 18

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de