PureBoard

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

ExcelFunktionen COMatePlus

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

Seite 3 von 18

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 11.09.2010 09:10
von ThoPie
Hallo Falko,
ich könnte wieder mal was gebrauchen. Ich habe das Problem, dass beim Erstellen der Excel-Datei und WriteCellS die führenden Nullen bei Zahlen weggelassen werden. Ich habe es auch schon mit einem vorangestellten Hochkomma probiert. Hast du evtl. eine Prozedur parat, mit der ich Zellformate (Text, Zahl, Währung) ändern kann? Also

Code: Alles auswählen

SetCellFormat(ExcelObject,Range,Format)
Vielen Dank

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 11.09.2010 16:36
von Falko
ThoPie hat geschrieben:Hallo Falko,
ich könnte wieder mal was gebrauchen. Ich habe das Problem, dass beim Erstellen der Excel-Datei und WriteCellS die führenden Nullen bei Zahlen weggelassen werden. Ich habe es auch schon mit einem vorangestellten Hochkomma probiert. Hast du evtl. eine Prozedur parat, mit der ich Zellformate (Text, Zahl, Währung) ändern kann? Also

Code: Alles auswählen

SetCellFormat(ExcelObject,Range,Format)
Vielen Dank
Hallo ThoPie,
speziell hierzu habe ich mal die Makros in Excel erzeugen lassen, wie dort der
Quelltext aussieht. Die Procedure müßte somit ähnlich wie beim vorherigen mit Range..
und selektiert werden und dann mit Selection\NumberFormat = '@'
in PB dann angepasst werden.

In VBA sieht es dann so aus:

Code: Alles auswählen

Sub Makro1()
'
' Makro1 Makro
'
'Format für Text setzen
'
    Range("E8").Select
    Selection.NumberFormat = "@"
End Sub

Sub Makro2()
'
' Makro2 Makro
'
'Format für Zahl mit Zwei stellen und 1000er-Trennung setzen
'
    Range("E12").Select
    Selection.NumberFormat = "#,##0.00"
End Sub

Sub Makro3()
'
' Makro3 Makro
'
'Format für Währung und Euro setzen
'
    Range("E16").Select
    Selection.NumberFormat = "#,##0.00 $"
    Range("D26").Select
End Sub
Ich werde mir dann mal ausdenken, wie ich das in PB umsetzten kann. Dauert aber noch ein bissle.

Gruß Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 11.09.2010 19:05
von Falko
Dein Wunsch habe ich dir hiermit erfüllt.

Code: Alles auswählen

Procedure SetCellFormat(ExcelObject.COMateObject, Range.s, Format.s);Set another format to Cells
  ExcelObject\Invoke("Range('"+Range+"')\Select")
  ExcelObject\SEtProperty("Selection\NumberFormat = '"+Format+"'")
EndProcedure
Beispiel-Code und PB-Include siehe oben dazu.

Die Kommentarbox habe ich zugleich um das Visible=#False erweitert. Zwar wollte ich das so machen, wie
es im Makro funktioniert, doch leider geht das so unter COMatePlus nicht so. Deshalb habe ich die alte Procedure
AddComment() im Include auskommentiert stehen gelassen und darüber meine eigene Kreation eingefügt.

Zu den Formaten kannst du am Besten aus der Exceltabelle
die Benutzerdefinierten Vorgaben auswählen und dann in der Zeile
Typ den entsprechenden kompletten String herauskopieren und diesen dann in
dein Programm als Parameter für Format einsetzen sowie anpassen.
Beispiel Euro: #.##0,00 €;[Rot]-#.##0,00 €

Gruß Falko

Gruß Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 12.09.2010 15:57
von ThoPie
Hallo Falko,
vielen vielen Dank für deine schnelle Unterstützung. Gib mir bitte mal deine PayPal-Daten, dann lass ich dir einen kleinen Dank zukommen.
ThoPie

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 12.09.2010 16:49
von Falko
ThoPie hat geschrieben:Hallo Falko,
vielen vielen Dank für deine schnelle Unterstützung. Gib mir bitte mal deine PayPal-Daten, dann lass ich dir einen kleinen Dank zukommen.
ThoPie
Freut mich sehr, das ich dir helfen konnte.
Bezüglich PayPal habe ich jetzt erst Eins angemeldet und muss bis zur Bestätigung noch einige
Tage warten, um dann die PayPal-Daten zu erhalten. Ich melde mich dann natürlich gern zurück.

Gruß, Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 24.09.2010 02:50
von Falko
Folgende Funktion habe ich noch hinzugefügt um den Namen der XLS - Datei zu ermitteln:

Code: Alles auswählen

Procedure.s GetWorkbookName(ExcelObject.COMateObject)
  Protected ReturnValue.s
   ReturnValue=ExcelObject\GetStringProperty("ActiveWorkbook\Name")
  ProcedureReturn ReturnValue
EndProcedure
Und nun funktioniert auch diese Procedure, dank Hilfe von Marko2007 :allright:

Code: Alles auswählen

Procedure MarkCellsRight(ExcelObject.COMateObject,Offset_Zeile.l=0,Offset_Spalte.l=0,Offset_Zeile1.l=0,Offset_Spalte1.l=0); Marks an offset from active Cell right from there
  ;Thanks marco2007 (german forum)
  Protected.COMateObject active
  Protected.s actadress,Range1,Range2,Range
  active = ExcelObject\GetObjectProperty("ActiveCell")
  actadress=active\GetStringProperty("address")
  If active
    Range1=active\GetStringProperty("Offset("+Str(Offset_Zeile)+","+Str(Offset_Spalte)+")\address"):Debug Range1
    Range2=active\GetStringProperty("Offset("+Str(Offset_Zeile1)+","+Str(Offset_Spalte1)+")\address"):Debug Range2
    Range=RemoveString(Range1+":"+Range2,"$"):Debug Range
    ExcelObject\Invoke("Range('"+Range+"')\Select")
    Debug "MarkCellsRight(): "+COMate_GetLastErrorDescription() 
    active\Release()
  EndIf
EndProcedure
Beide Funktionen habe ich der ExcelFunction.pbi hinzugefügt, bzw. korrigiert.

Gruß Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 25.09.2010 12:43
von ThoPie
Hallo Falko,

ich habe mal wieder zwei Vorschläge / Wünsche:
1. Setzen der Seitenränder
2. Änderung des Formates der Tabelle (Hochformat - Querformat)

Achso noch etwas:
Wäre es nicht sinnvoll in deiner Include alle Prozeduren mit einem Präfix zu versehen, also z.B.:

Code: Alles auswählen

XLSFunc_CreateExcelFile
ThoPie

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 26.09.2010 23:19
von Falko
ThoPie hat geschrieben:Hallo Falko,

ich habe mal wieder zwei Vorschläge / Wünsche:
1. Setzen der Seitenränder
2. Änderung des Formates der Tabelle (Hochformat - Querformat)

Achso noch etwas:
Wäre es nicht sinnvoll in deiner Include alle Prozeduren mit einem Präfix zu versehen, also z.B.:

Code: Alles auswählen

XLSFunc_CreateExcelFile
ThoPie
Hallo ThoPie,
einen Wunsch habe ich dir in der Zwischenzeit erfüllen können. Die Präfixe sind nun
vorhanden und im Beispiel in der PBI und PB angepasst.

Mit den anderen Page-Einstellungsdaten muss ich wohl etwas tiefer an diese
VBA-Macros reingehen. Sobald ich etwas mehr Luft zu meinen aktuellen ExcelProjekt
habe, werde ich mich aber gleich dran machen.

Nach VBA sind Seitenformat HochKannt und Quer sowie die Randeinstellungen unter
einer Funktion einzustellen. Das sieht im Originalmakro etwa so aus:

Code: Alles auswählen

Sub Makro1()
'
' Makro1 Makro
'

'
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 200
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 200
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub
Dazu muss ich mir in COMatePlus aber was einfallen lassen, da man dort leider kein With verwenden kann,
als auch alle Objekte,Methoden usw. auseinander pflücken muss.
Das wäre natürlich schöner, wenn man mehrere Funktionen bzw. die Methoden in PB und Comate
verschachteln könnte.


Gruß, Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 27.09.2010 20:15
von Falko
Ich habe nun die von ThoPie gewüinschten Funktionen des PageSetups als PB-Source mit Seitenrändern incl. Header-, und Footer-Rand
sowie das Seitenformat Hoch-, und Querformat in die Lib eingebaut. :)

Die Procedure sieht dann so aus. Dabei habe ich zur Überprüfung die ganzen Debugs drin gelassen. :allright:

Code: Alles auswählen

Procedure XLSFunc_PageSetup(ExcelObject.COMateObject,Orient.l=#xlPortrait,Left.d=1.3,Right.d=1.5,Top.d=2.0,Bottom.d=2.0,Header.d=1,Footer.d=1,HorCenter.b=#False,VertCenter.b=#False);  xlLandscape Or xlPortrait
   Protected.COMateObject active
   Protected.d LeftM,RightM,TopM,ButtomM,HeaderM,FooterM
   
   active = ExcelObject\GetObjectProperty("ActiveSheet")
   
   If active
     active\SetProperty("PageSetup\Orientation="+Str(Orient))
     Debug "Orientation: "+COMate_GetLastErrorDescription()
     
     LeftM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Left)+")")
     active\SetProperty("PageSetup\LeftMargin="+StrD(LeftM))
     Debug "LeftMargin: "+COMate_GetLastErrorDescription()
     
     RightM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Right)+")")
     active\SetProperty("PageSetup\RightMargin="+StrD(RightM))
     Debug "RightMargin: "+COMate_GetLastErrorDescription()
     
     TopM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Top)+")")
     active\SetProperty("PageSetup\TopMargin="+StrD(TopM))
     Debug "TopMargin: "+COMate_GetLastErrorDescription()
     
     ButtomM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Bottom)+")")
     active\SetProperty("PageSetup\BottomMargin="+StrD(ButtomM))
     Debug "BottomMargin: "+COMate_GetLastErrorDescription()
     
     HeaderM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Header)+")")
     active\SetProperty("PageSetup\HeaderMargin="+StrD(HeaderM))
     Debug "HeaderMargin: "+COMate_GetLastErrorDescription()
     
     FooterM=ExcelObject\GetRealProperty("Application\CentimetersToPoints("+StrD(Footer)+")")
     active\SetProperty("PageSetup\FooterMargin="+StrD(FooterM))
     Debug "FooterMargin: "+COMate_GetLastErrorDescription()
     
     active\SetProperty("PageSetup\CenterHorizontally="+Str(HorCenter))
     Debug "CenterHorizontally: "+COMate_GetLastErrorDescription()
     
     active\SetProperty("PageSetup\CenterVertically="+Str(VertCenter))
     Debug "CenterVertically: "+COMate_GetLastErrorDescription()  
     
   EndIf
   
   active\Release()
 EndProcedure
Gruß Falko

Re: ExcelFunktionen PureDisphelper / COMate

Verfasst: 27.09.2010 21:05
von marco2007
Noch ein kleiner Vorschlag: Seite 4? Der tolle Include-Code sollte im ersten Posting eines Threads sein :D
Alle Zeiten sind UTC+02:00
Seite 3 von 18

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de