PureDispHelper Userlib - Update Include für Unicode Support

Beitrag von **Kiffi** » 03.07.2007 18:36

Falko hat geschrieben:hast du noch ein Beispiel, wie man eine komplette Fusszeile auslesen als auch schreiben kann?

yepp:

[...]

dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.LeftHeader")
If ReturnValue
  Debug "Kopfzeile links: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf
  
dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.CenterHeader")
If ReturnValue
  Debug "Kopfzeile mitte: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf
  
dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.RightHeader")
If ReturnValue
  Debug "Kopfzeile rechts: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf
  
dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.LeftFooter")
If ReturnValue
  Debug "Fußzeile links: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf
  
dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.CenterFooter")
If ReturnValue
  Debug "Fußzeile mitte: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf
  
dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.RightFooter")
If ReturnValue
  Debug "Fußzeile rechts: " + PeekS(ReturnValue)
  dhFreeString(ReturnValue)
EndIf

[...]

das schreiben dann analog so:

Code: Alles auswählen

dhPutValue(ExcelApp, ".ActiveSheet.PageSetup.RightFooter=%T", @"Neuer Text für Fußzeile rechts")

Grüße ... Kiffi

ts-soft · Beitrag von **ts-soft** » 03.07.2007 18:36

Sub PartLeftFooter()
Dim intCounter As Integer, intChr As Integer
Dim sTxt As String
sTxt = ActiveSheet.PageSetup.LeftFooter; dhGetValue()
Do Until InStr(sTxt, vbLf) = 0; stringfield
For intCounter = Len(sTxt) To 1 Step -1
If Asc(Mid(sTxt, intCounter, 1)) = 10 Then Exit Do
intChr = Asc(Mid(sTxt, intCounter, 1))
If intCounter = 1 Then Exit Sub
Next intCounter
Loop
sTxt = Right(sTxt, Len(sTxt) - intCounter)
sTxt = Trim(Right(sTxt, Len(sTxt) - InStr(sTxt, ":")))
ActiveSheet.TextBox1.Text = sTxt; dhPutValue()
End Sub

Kannst doch erstmal selbst probieren, wichtige stellen sind fett. Ich kann
leider nicht testen, verzichte somit auf Übersetzung

Wenn dann noch Fehler kommen, haste es Kiffi schon mal etwas einfacher
gemacht und selbst schon was gelernt (und wenn es nur ist: so gehts nicht)

Gruß
Thomas

// Nachtrag:
Unerwartetes Posting von Peter macht meins überflüssig

Beitrag von **Falko** » 03.07.2007 19:42

Danke, das klappt beides prima unter Excel 2007.

Sorry, Thomas, ich habe Kiffis Variante genommen, da ich die
einzelnen Funktionen in jeweils eine eigene Procedure einschliessen kann.

Eure Tips sind Goldwert

.
Nun steht unter Excel und Pb nichts mehr im Wege.

Danke vielmals

Grüße ..Falko

Beitrag von **Kiffi** » 03.07.2007 19:47

ts-soft hat geschrieben:Unerwartetes Posting von Peter

unerwartet?

@Falko: Der Code, den Du da bei Herber gefunden hast, ist sehr seltsam.
Ich hoffe, ich trete niemanden zu nahe, wenn ich mal so behaupte, dass das
ziemlicher Bullsh*t ist.

Grüße ... Kiffi

Beitrag von **Falko** » 03.07.2007 20:28

Hier ist z.B. die Seite: http://www.herber.de

Wegen dem Zunahetreten, ich fühle mich nicht angesprochen

Das war auch nur ein Auszug aus der CHM, die ich mir mal geladen hatte und
unter Suche zu Kopf- und Fußzeilen habe ich nur den obigen VBA-Source
gefunden.

Ist aber interessant, wie man es in PB nutzen kann.
Vor allem, daß durch eure gute Kenntnisse Excel durch PB nutzbar ist.

Ich habe mir jetzt aus Deinen und ts-softs Beispielen eine Pbi erstellt, mit der man
nun Zellen sowie die Kopf- und Fußzeilen auslesen und schreiben
kann. Mit dem 'EnableExplicit' und dem Define muss ich mich im Bezug zu
Proceduren und interne Variablendeclarierung noch anfreunden

Grüße ..Falko

Beitrag von **Falko** » 03.07.2007 21:04

Ich hab hier nochmal dank ts-soft und kiffis Hilfe hier einen zusammen-
gefassten Demosource erstellt.

Vielleicht besteht Interesse für eine Zukünftige PB-Lib zum nachträglichen
Bearbeiten von Exceltabellen.

Beispiel: 1600Dateien, welche in der Fußzeile geändert werden müßen,
wäre von Hand in Excel doch sehr mühselig

Ok, dazu müßte das Quitt ohne eine Speicheranforderung von Excel kommen.

Gruß Falko

[Edit] Source korrigiert und das Quitt ohne Speicheraufforderung von
Excel funktioniert jetzt auch
[/Edit]

Code: Alles auswählen

EnableExplicit

Procedure.s ReadCellS(*obj, Zeile.l,Spalte.l)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, "Cells(%d, %d).Value",Zeile, Spalte) ; read one value
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure


Procedure WriteCellS(*obj, Zeile.l, Spalte.l, NewValue.s)
  dhPutValue(*obj, "Cells(%d, %d).Value = %T", Zeile, Spalte, @NewValue) ; write one value
EndProcedure


Procedure WriteCellZ(*obj, Zeile.l, Spalte.l, NewValueZ.d)
  dhPutValue(*obj, "Cells(%d, %d).Value = %e", Zeile, Spalte, @NewValueZ) ; write one value
EndProcedure

Procedure.s ReadLeftHeader(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.LeftHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure


Procedure.s ReadCenterHeader(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.CenterHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure


Procedure.s ReadRightHeader(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.RightHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure.s ReadLeftFooter(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.LeftFooter")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure.s ReadCenterFooter(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.CenterFooter")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure.s ReadRightFooter(*obj)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, ".ActiveSheet.PageSetup.RightFooter")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure WriteLeftHeader(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.LeftHeader=%T", @Text)
EndProcedure

Procedure WriteCenterHeader(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.CenterHeader=%T", @Text)
EndProcedure

Procedure WriteRightHeader(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.RightHeader=%T", @Text)
EndProcedure

Procedure WriteLeftFooter(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.LeftFooter=%T", @Text)
EndProcedure

Procedure WriteCenterFooter(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.CenterFooter=%T", @Text)
EndProcedure

Procedure WriteRightFooter(*obj, Text.s)
  dhPutValue(*obj, ".ActiveSheet.PageSetup.RightFooter=%T", @Text)
EndProcedure

Procedure CloseExcelAll(*obj)
  dhPutValue(*obj, ".Application.DisplayAlerts = %b", #False)
  dhCallMethod(*obj, ".Quit"); Close Excel
EndProcedure

Procedure CloseWorkbook(*obj)
  Protected Workbook.l
 
  dhGetValue("%o", @Workbook, *obj, ".ActiveWorkbook")
 
  If Workbook
    dhPutValue(*obj, ".Application.DisplayAlerts = %b", #False)
    dhCallMethod(Workbook, ".Close"); Close Exceltable
    dhReleaseObject(Workbook)
    dhPutValue(*obj, ".Application.DisplayAlerts = %b", #True)
  EndIf
 
EndProcedure
 
Define.l Pattern, ExcelAPP
Define.s StandardFile, sPattern, Datei, StandardFile, Text

StandardFile = ""
sPattern = "Text (*.xls)|*.xls|Alle Dateien (*.*)|*.*"
Pattern = 0
Datei = OpenFileRequester("Bitte eine XLS-Datei auswählen", StandardFile, sPattern, Pattern)
 

dhToggleExceptions(#True); Toggles error messages from DispHelper on or off

ExcelApp = dhCreateObject("Excel.Application")

If ExcelApp
 
  dhCallMethod(ExcelApp, ".Workbooks.Open(%T)", @Datei) ; open ExcelFile
  dhPutValue(ExcelApp, ".Visible = %b", #True) ; Visible Excel
 
; -- Here write your code


MessageRequester("Read_Cells", ReadCellS(ExcelApp, 2, 1))
WriteCellS(ExcelApp, 1, 1, "Hier mein eigener Text")
WriteCellZ(ExcelApp, 1, 7, 20.56)

Text = "Linke Kopfzeile: " + ReadLeftHeader(ExcelApp) + #CRLF$
Text + "Mittlere Kopfzeile: " + ReadCenterHeader(ExcelApp) + #CRLF$
Text + "Rechte Kopfzeile: " + ReadRightHeader(ExcelApp) + #CRLF$
Text + "Linke Fußzeile: " + ReadLeftFooter(ExcelApp) + #CRLF$
Text + "Mittlere Fußzeile: " + ReadCenterFooter(ExcelApp) + #CRLF$
Text + "Rechte Fußzeile: " + ReadRightFooter(ExcelApp)
MessageRequester("Excel_Kopf&Fusszeile", Text)

; -- End of code
CloseWorkbook(ExcelApp); for changing another table, close this table.

;...

;CloseExcelAll(); for end of Excel

 
 dhReleaseObject(ExcelApp) : ExcelApp = 0
 
Else
 
  MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
 
EndIf

ts-soft · Beitrag von **ts-soft** » 03.07.2007 21:15

Leider kleiner Denkfehler

ProcedureReturn verläßt die Procedure umgehend

Code: Alles auswählen

Procedure.s ReadRightFooter()
  Shared ReturnValue.l,ExcelApp.l
  dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.RightFooter")
  If ReturnValue
    ProcedureReturn PeekS(ReturnValue)
    dhFreeString(ReturnValue)
  Else
    ProcedureReturn "0"
  EndIf
EndProcedure

dhFreeString wird im Erfolgsfalle nie ausgeführt, Du mußt also eine Return-
Variable nutzen, wo Du den String zwischenspeicherst!

Anstatt shared würde ich lieber einen Parameter nutzen (für das object),
und ReturnValue protected setzen!

Beitrag von **Falko** » 03.07.2007 21:28

Meinst du das in etwas so?

Code: Alles auswählen

Procedure.s ReadLeftHeader()
Shared ExcelApp.l
Protected ReturnValue.l
  dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.LeftHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
  Else
    Resume="0"
    dhFreeString(ReturnValue)
  EndIf
  ProcedureReturn Resume
EndProcedure

Gruß Falko

Beitrag von **Kiffi** » 03.07.2007 21:29

Falko hat geschrieben:Hier ist z.B. die Seite: http://www.herber.de

joh, kenne ich schon etwas länger. Hat mich nur gewundert, dass es da
solche Codes gibt. Bis jetzt hat man mir dort immer kompetent helfen
können, so dass ich davon ausgegangen bin, dass die Codes dort ein
gewisses Maß an Qualität aufweisen. Wird wohl 'n noch nicht kontrollierter
Ausreißer sein.

Grüße ... Kiffi

ts-soft · Beitrag von **ts-soft** » 03.07.2007 21:40

Falko hat geschrieben:Meinst du das in etwas so?

Code: Alles auswählen

Procedure.s ReadLeftHeader()
Shared ExcelApp.l
Protected ReturnValue.l
  dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.LeftHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
  Else
    Resume="0"
    dhFreeString(ReturnValue)
  EndIf
  ProcedureReturn Resume
EndProcedure

Gruß Falko

Ja, so ist es korrekt, aber etwas kürzer:

Code: Alles auswählen

Procedure.s ReadLeftHeader()
  Shared ExcelApp.l
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, ExcelApp, ".ActiveSheet.PageSetup.LeftHeader")
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

finde ich schöner