ExcelFunktionen COMatePlus

[LuZiF3R]

funzt super, Danke

[Falko]

Das freut mich.

Gruß,
Falko

[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

[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

[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

[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

[Falko]

Das Ganze nochmal zusätzlich mit der Funktion für Textbox, welche ich nun auch
in der ExcelFunctions.pbi hinzugefügt habe

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)

.

[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

[Falko]

Hallo,
meinst du so was wie in dieser VBA-Funktion?

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")

bzw.

Worksheets("Sheet1").Copy Before:=Worksheets("Sheet3")

Gruß,
Falko

[MightyMAC]

Ja, genau.

[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.