ExcelFunktionen COMatePlus

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
ThoPie
Beiträge: 130
Registriert: 19.05.2006 15:18
Kontaktdaten:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
ThoPie
Beiträge: 130
Registriert: 19.05.2006 15:18
Kontaktdaten:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
ThoPie
Beiträge: 130
Registriert: 19.05.2006 15:18
Kontaktdaten:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
Benutzeravatar
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:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag 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
Bild
Win10 Pro 64-Bit, PB_5.4,GFA-WinDOS, Powerbasic9.05-Windows, NSBasic/CE, NSBasic/Desktop, NSBasic4APP, EmergenceBasic
marco2007
Beiträge: 906
Registriert: 26.10.2006 13:19
Kontaktdaten:

Re: ExcelFunktionen PureDisphelper / COMate

Beitrag von marco2007 »

Noch ein kleiner Vorschlag: Seite 4? Der tolle Include-Code sollte im ersten Posting eines Threads sein :D
Windows 11 - PB 6.03 x64
_________________________________
Antworten