[gelöst] frage zu makro für tabelle als pdf und e-mail vers

[junmod]

hallo forum,

ich bin noch makro anfänger und habe mir mühsam ein makro zusammengebaut, dass ein oo calc dokument als pdf speichert und automatisch in eine e-mail einfügt. der pdf name wird durch eine tabellenzelle bestimmt und mein mail programm ist mozilla thunderbird.

jetzt hab ich 2 probleme:

1. mein dokument besteht aus 2 tabellen. wie bekomme ich das hin, dass ich im fall, dass in der 2. tabelle kein eintrag ist, nur die erste gespeichert und verschickt wird und wenn doch ein eintrag vorhanden ist, dass beide in einem pdf gespeichert und verschickt werden?

2. bis jetzt erscheint in der mail der anhang (pdf datei), der empfänger (aus der tabelle) und der betreff korrekt. jetzt würde ich gerne als text noch "sehr geehrte damen und herren,...." einfügen, was ich mit "body=" versucht habe, doch da liegt mein 2. problem denn ich habe standardmäßig eine signatur an meinen mails und der eingefügte text erscheint darunter. wie bekomme ich es hin, dass der text über meiner signatur erscheint. als hinweis: in thunderbird hab ich es so eingestellt, dass die signatur immer unten steht.

ich würde mich sehr freuen wenn ihr mir helfen könntet.

gruss
dirk

[sven-my]

Hallo Dirk,

ein ähnliches Problem habe ich dadurch gelöst, daß ich die Lösung von OpenOffice nach Thunderbird verlagert habe.
Das bedarf nicht irgendwelcher Klimmzüge, wenn es überhaupt machbar ist.

Ich nutze dafür in Thunderbird 11.0.1 "Quicktext vers. 0.9.11.3", da gibt es auch kein Problem mit der Signatur.
Voraussetzung ist natürlich, daß die Adressen im Adressbuch von Thunderbird sind.

gruß
sven-my

[Frieder D.]

Hallo Dirk

Leider habe ich im Moment nicht sehr viel Zeit, und kann dir deshalb nicht das gesamte Makro schreiben.

Aber zu 1. :

du kannst mit einer if-abfrage schauen, ob in der zweiten Tabelle Einträge sind.
für jede nicht leere Tabelle setzt du einen Druckbereich, und exportierst das PDF mit den Argumenten:

Code: Alles auswählen

  args2(2).Name = "SelectionOnly" 'Das bewirkt, 
'dass nur der ausgewählte Druckbereich Exporrtiert wird.
  args2(2).Value = true

Nach dem Export lösche wieder alle Druckbereiche.


Trage einfach in dem sub Main den gewünschten Pfad ein und führe es aus. dann werden alle Tabellen, die nicht leer sind als PDF exportiert.

Code: Alles auswählen

 
REM  *****  BASIC  *****

Sub Main
Dim sFileName AS String
sFileName="C:\Users\Nansen\Documents\MeinPdf415.pdf"
 Export_not_empty_Sheets (sFileName)
End Sub

Sub Export_not_empty_Sheets (sFileName AS String)
Dim oDoc as object
Dim oSheet as object
dim nRow as long
dim nCol as Long
  oDoc = ThisComponent
  for n=0 to  oDoc.Sheets.getcount-1
    oSheet = oDoc.Sheets(n)
    if GetLastUsedRow(oSheet)=0 and GetLastUsedColumn(oSheet)=0 and (oSheet.getCellByPosition(0,0).String = "") Then
         'msgbox  oSheet.name & " ist leer.",0,""
    Else
        'msgbox oSheet.name &" ist Nicht leer.",0,"" 
        nRow = GetLastUsedRow(oSheet)
        nCol = GetLastUsedColumn(oSheet)
        Set_PrintAreas (n,0,0,nCol,nRow)
    End if
  Next
  export_pdf (ConvertToUrl(sFileName) )
  Delete_PrintAreas 'Drukbereich wieder Löschen
end sub

sub export_pdf (sFileName AS String)

  dim args1(1) as new com.sun.star.beans.PropertyValue

  args1(0).Name = "ExportFormFields" 'just show the contents of the Form.Fields
  args1(0).Value= True
  args1(1).Name = "Printing" ' you don't need that.
  args1(1).Value= 0
'hier können noch weiter Optionen eingegeben werden

  dim args2(2) as new com.sun.star.beans.PropertyValue

  args2(0).Name = "FilterName"
  args2(0).Value = "calc_pdf_Export"
  args2(1).Name = "FilterData"
  args2(1).Value = args1
  args2(2).Name = "SelectionOnly" 'Das bewirkt, 
'dass nur der ausgewählte Druckbereich Exporrtiert wird.
  args2(2).Value = true

  ThisComponent.storeToURL(sFileName,args2())
end sub

Sub Set_PrintAreas (nSheet As Integer,lStartCol As Long,_
lStartRow As Long,lEndCol As Long,lEndRow As Long) 'Drukbereich festlegen
  Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
  oDoc = ThisComponent
  oSheet = oDoc.Sheets(nSheet)
  CellRangeAddress.Sheet = nSheet
  CellRangeAddress.StartColumn = lStartCol
  CellRangeAddress.StartRow = lStartRow
  CellRangeAddress.EndColumn = lEndCol
  CellRangeAddress.EndRow = lEndRow
  aPrintAreas()=Array (CellRangeAddress)
  oSheet.setPrintAreas(aPrintAreas())

End sub

Function GetLastUsedRow(oSheet as Object) As Integer 
  Dim oCell
  Dim oCursor
  Dim aAddress
  
  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.gotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
End Function
REM Returns the number of the last column 
'of a continuous data range in a sheet.
Function GetLastUsedColumn(oSheet as Object) As Long
  Dim oCell
  Dim oCursor
  Dim aAddress

  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.gotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedColumn = aAddress.EndColumn
End Function

sub Delete_PrintAreas 
Dim oDoc As Object

Dim n%
  oDoc = ThisComponent
  for n =0 to oDoc.Sheets.getCount - 1
    oDoc.Sheets(n).setPrintAreas(Array ())
  Next
end sub

Zu 2. :
Dazu findest du hier auf meiner Homepage was du brauchst.

Gruß Frieder

[junmod]

Hallo sven-my und Frieder,

ich danke Euch für Eure Lösungsvorschläge. Ich war aber in der Zwischenzeit auch nicht ganz untätig und was ich mir da zusammengebastelt habe funktioniert tatsächlich perfekt. Möglicherweise ist das Makro etwas umständlich geschrieben, aber es erfüllt den gewünschten Zweck.

Vielleicht möchtet Ihr es noch kommentieren und für Verbesserungsvorschläge bin ich immer offen.

Code: Alles auswählen

REM  *****  BASIC  *****

Sub BestellungSpeichernUndVersenden

REM Definition der Variablen
Dim document as Object
Dim dispatcher as Object
Dim stringname as String
Dim PDFempfText as String
Dim ODScalc as Object
Dim strAttPfad As String

Calc = ThisComponent
Sheet = Calc.Sheets(0)

REM Bestellnummer finden
Cell = Sheet.GetCellRangeByName("AE9")
StringName = Cell.String

REM Seitenzahl ermitteln
CCell = Sheet.GetCellRangeByName("AG10")
ZStringName = CCell.String

REM Empfängername finden
CCCell = Sheet.GetCellRangeByName("A10")
PDFempfString = CCCell.String

REM Dokumentenzugriff
document   = ThisComponent.CurrentController.Frame
dispatcher = CreateUnoService("com.sun.star.frame.DispatchHelper")

REM Wenn Bestellung 1-seitig
If ZStringName = "0" then

REM Druckbereich für 1 Seite
dim args10(1) as new com.sun.star.beans.PropertyValue
args10(0).Name = "ToPoint"
args10(0).Value = "$A$1:$AF$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

REM PDF-Export
dim args11(1) as new com.sun.star.beans.PropertyValue
args11(0).Name = "URL"
args11(0).Value = "file:///D:/PDF-Bestellungen/Bestellung." & stringname & ".pdf"
args11(1).Name = "FilterName"
args11(1).Value = "calc_pdf_Export"

dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args11())

REM Druckbereich entfernen
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array()

REM Wenn Bestellung 2-seitig
Else

REM Druckbereich für 2 Seiten
dim args20(1) as new com.sun.star.beans.PropertyValue
args20(0).Name = "ToPoint"
args20(0).Value = "$A$1:$AF$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args20())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

dim args21(1) as new com.sun.star.beans.PropertyValue
args21(0).Name = "Nr"
args21(0).Value = 2

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args21())

dim args22(1) as new com.sun.star.beans.PropertyValue
args22(0).Name = "ToPoint"
args22(0).Value = "$A$1:$AF$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args22())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

REM PDF-Export
Datei =  "file:///D:/PDF-Bestellungen/Bestellung." & stringname & ".pdf"
dim pdfproperties(1) as new com.sun.star.beans.PropertyValue
pdfproperties(1).Name = "FilterName"
pdfproperties(1).Value = "calc_pdf_Export"

ThisComponent.StoreToUrl( Datei, pdfproperties())
StrAttPfad = ThisComponent.GetUrl ("file:///D:/PDF-Bestellungen/Bestellung." & stringname & ".pdf")

REM Druckbereiche entfernen
dim args23(1) as new com.sun.star.beans.PropertyValue
args23(0).Name = "ToPoint"
args23(0).Value = "$A$1:$AF$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args23())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array())

dim args24(1) as new com.sun.star.beans.PropertyValue
args24(0).Name = "Nr"
args24(0).Value = 2

dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args24())

dim args25(1) as new com.sun.star.beans.PropertyValue
args25(0).Name = "ToPoint"
args25(0).Value = "$A$1:$AF$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args25())

dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array())

End If

REM ODS-Datei speichern
ODScalc = ThisComponent
ODScalc.Store()

REM Messagebox
PDFempfText = "Die Bestellung Nr. " & stringname & " an " & PDFempfString
msgbox PDFempftext & " wurde erfolgreich gespeichert!", 64, "Herzlichen Glückwunsch!"

REM gespeicherte PDF senden
Dim strAn As String
Dim strBetr As String
Dim strBody As String

Dim strThunderPfad As String
Dim strShell As String

strThunderPfad = """C:\Programme\Mozilla Thunderbird\Thunderbird.exe"""

mDoc = thisComponent
mSheet = mDoc.sheets(0)
mCell = mSheet.getCellRangeByName("AH17")
mStran = mCell.String


strAn = mStran
strBetr = "Bestellung Nr. " & stringname
strBody = "&#160;<br>Sehr geehrte Damen und Herren&#130;<p>im Anhang finden Sie meine&#160;" & strBetr & "<p>Mit freundlichen Gr&#252;&#223;en<p>"

strShell = strThunderPfad & _
"-compose " & _
"to='" & strAn & "'," & _
"subject='" & strBetr & "'," & _
",body=" & strBody & _
",attachment=" & ("file:///D:/PDF-Bestellungen/Bestellung." & stringname & ".pdf")

Call Shell(strShell, vbNormalFocu)

End Sub

Gruß
Dirk

[sven-my]

Hallo Dirk,

von Deinem Makro habe ich mal den Teil ab

REM gespeicherte PDF senden

ausprobiert, da ich es gut für ein anderes Makro von mir brauchen kann.

Leider hab' ich Schwierigkeiten, wenn in dem Dateinamen LEERZEICHEN sind - hast Du dafür eine Lösung ? Mit den mehrfachen Anführungszeichen >"< klappt es nicht.

Hast Du dafür eine Lösung ?

gruß
sven-my

[sven-my]

Hallo Gast,

is schon klar, aber dann müßte ich mein anderes Makro reichlich ändern - was mir denn doch zuviel Arbeit ist.

meine Dateien sehen so aus:

speichername..........JJJJ-MM-TT_NN_ART.ERW (wobei die Punkte Leerzeichen sind, die aber hier im Forum nicht korrekt dargestellt werden)

speichername = Empfänger
JJJJ-MM-TT = Datum
NN = laufende Nummer
ART = Art des Versendens (Fax, S´nailmail, eMail)
ERW = Erweiterung (odt, pdf, doc)

mit den Leerzeichen wird der speichername so aufgefüllt, daß alles, incl. Erweiterung, 40 Zeichen lang ist.
Da meine Dateinamen seit Jahren so aufgebaut sind, möchte ich jetzt nicht mehr daran ändern, weil die Sucherei dann etwas komplizierter wird.

gruß
sven-my

[Karolus]

Hallo

Code: Alles auswählen

...
msgbox converttourl("C:\pfad mit Leerzeichen\blah.pdf")
..

Karo

[sven-my]

Hallo Karo,

das kommt davon, wenn man estwas auf die Schnelle machen will:

Code: Alles auswählen

strShell = strThunderPfad & _
"-compose " & _
"to='" & strAn & "'," & _
"subject='" & strBetr & "'," & _
",body=" & strBody & _
",attachment=" & ("file:///D:/PDF-Bestellungen/Bestellung." & stringname & ".pdf")

Call Shell(strShell, vbNormalFocu)

Ich bin einfach so vorgegangen : stringname = dokumentname (ohne Erweiterung), anstatt Pfad & Dokumentname & Erweiterung zu URL zu convertieren - so, wie es sonst auch immer gemacht habe.
Jetzt klappt es ! Herzlichen Dank.

gruß
sven-my

[junmod]

Freut mich, dass Ihr mit meinem "Laien-Makro" was anfangen könnt.

Gruss
Dirk

[Karolus]

Hallo

Bei Thunderbird war und ist es, soweit ich weiß, immer noch nicht dokumentiert,sondern das hat ein Tüftler herausgefunden, der es dann im Thunderbird-Forum veröffentlicht hat.

Unsinn!

Tippe thunderbird --help in einer shell, und du hast deine Dokumentation.

Karo

[sven-my]

Hallo Remo,

probiers mal so:

den Bereich, den Du drucken willst markieren (linke Maustaste) , dann FORMAT / DRUCKBEREICHE / hinzufügen.

Dann schau Dir das Ganze in der Seiten vorschau an, ob es Deinen Wünschen entsprucht. Ansonsten, wenn z.B. die Spalten zu breit sind, muß Du eben am Layout was ändern.

gruß
sven-my

[sven-my]

Hallo Remo,

da war ich ich auf dem falschen Dampfer.

Falls ich mich nicht vertue, mußt Du nur diesen Teil ändern:

Code: Alles auswählen

    REM Druckbereich für 2 Seiten
    dim args20(1) as new com.sun.star.beans.PropertyValue
    args20(0).Name = "ToPoint"
    args20(0).Value = "$A$1:$AF$61"

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args20())
    dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

    dim args21(1) as new com.sun.star.beans.PropertyValue
    args21(0).Name = "Nr"
    args21(0).Value = 2

    dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args21())

    dim args22(1) as new com.sun.star.beans.PropertyValue
    args22(0).Name = "ToPoint"
    args22(0).Value = "$A$1:$AF$61"

Du schreibst:

Ich brauche nur folgenden Bereich als PDF "Tabelle 2 - A1:G808"

808 Zeilen wird sicher mehr geben, als nur zwei Seiten DIN A4!

Nur ist für mich nicht nachvollziehbar, was Dirk (junmod) da gebaut hat - da ich keine Ahnung habe, wie seine Tabelle(n) aufgebaut sind (ich stolpere über die Angabe : "$A$1:$AF$61" und "REM Druckbereich für 2 Seiten")

tut mir leid, daß ich Dir nicht weiterhelfen kann.

gruß
sven-my

[sven-my]

Hallo Remo,

vielleicht hilft Dir das weiter:

Code: Alles auswählen

rem Druckbereich per Makro festlegen
sub Druckbereich

Dim aDruckbereich(0)
oDoc = thiscomponent
oSheet = oDoc.Sheets.getByName("gesamt")

AZ = oSheet.getCellRangeByName("L14").value
EZ = oSheet.getCellRangeByName("M14").value

AZn = format(AZ,"#")
EZn = format(EZ,"#")

Bereich = "$A$" & AZn & ":" & "$G$" & EZn

oZellRange = oSheet.getCellRangeByName(Bereich)
oCursor = oSheet.createCursorByRange(oZellRange)
oAdress = oCursor.RangeAddress
aDruckbereich(0) = oAdress
oSheet.setPrintAreas(aDruckbereich)

end sub

Dabei habe ich in der Tabelle "gesamt" in Zellen, die nicht mitgedruckt werden, die Information geschrieben, von wo bis wo der Druckbereich geht.
Diese Info lese ich per Makro aus, und schreibe sie mit diesem Makro hin, wo man es sonst "mit der Hand" macht: FORMAT/DRUCKBEREICHE/
Dabei stehen in meinen Zellen nur die Zeilen-Nummern, da die Spalten feststehen. (A...G).
Falls Du aber Spalte + Zeile in die Zellen schreibst, mußt Du

Code: Alles auswählen

AZ = oSheet.getCellRangeByName("L14").value

in

Code: Alles auswählen

AZ = oSheet.getCellRangeByName("L14").string

ändern

Damit kannst Du den Bereich per Makro auslesen:

Code: Alles auswählen

myDoc = ThisComponent
mySheet = myDoc.Sheets().getByName("neu")
ocursor = mySheet.createCursor()
ocursor.gotoEndofUsedArea(false)	    		'letzte Zelle des Bereichs
lSpN = ocursor.getRangeAddress.endColumn        'letzte Spalte des Bereichs
lZeN = ocursor.getRangeAddress.endRow   		'letzte Zeile des Bereichs

oder, wenn Du feste Bereiche hast, in das obere Makro fest reinschreiben.

also

Code: Alles auswählen

Bereich = "$A$1:$G$808"

gruß
sven-my

[sven-my]

Hallo Remo,

heute nur eine kurze Antwort - keine Zeit mehr.


Hast Du denn tatsächlich in den Zellen L14 und M14 auf dem Tabellenblatt "offerte" die erste und letzte Zeile stehen von dem Bereich des Tabellenblattes "offerte", den Du ausdrucken willst ?

Probiere doch erst mal nur diesen Teil aus (neues Modul erstellen), indem Du nur diesen Teil in das Neue Modul schreibts, und das Mokro einmal ausführst, und dann Seitenvorschau anklickst :

Code: Alles auswählen

sub Druckbereich

Dim aDruckbereich(0)
oDoc = thiscomponent
oSheet = oDoc.Sheets.getByName("gesamt")

AZ = oSheet.getCellRangeByName("L14").value
EZ = oSheet.getCellRangeByName("M14").value

AZn = format(AZ,"#")
EZn = format(EZ,"#")

Bereich = "$A$" & AZn & ":" & "$G$" & EZn

oZellRange = oSheet.getCellRangeByName(Bereich)
oCursor = oSheet.createCursorByRange(oZellRange)
oAdress = oCursor.RangeAddress
aDruckbereich(0) = oAdress
oSheet.setPrintAreas(aDruckbereich)

end sub

gruß
sven-my

[sven-my]

Hallo remo,

an dem Calc-Dokumnet kannst Du mal ausprobieren, wie Du das bei Deinem Dokument einbauen kannst.

wenn Du Dir das Makro, und die dazu gehörigen Zellen anschaust, wirst Du schon rausfinden, warum es bei Dir nicht so hinhaut, wie Du es willst.

Test-remo.ods

(12.56 KiB) 164-mal heruntergeladen

- getestet und funktioniert

Die eine Version arbeite mit Zahlen (die Spalten stehen im Makro fest), und in den beiden Zellen stehen nur die beiden Zeilen-Nummern;
die zweite mit Text, also in dieser Form: z.B. >A1< und >G8<

gruß
sven-my