OpenOffice.info

Code: Alles auswählen

Druckbereich = inputbox("","","")
Druckbereich = inputbox("von wo bis wo ?","","")
Druckbereich = inputbox("von wo bis wo ?","Druckbereich festlegen","")
Druckbereich = inputbox("von wo bis wo ?","Druckbereich festlegen","---:---")
AZ = left(Druckbereich,3)
EZ = right(Druckbereich,3)

oder

Bereich = Druckbereich 'dann muß aber der Doppelpunkt zwingend mit eingegeben werden, und auch die Zeile "Bereich =" gelöscht werden

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

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

Code: Alles auswählen

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

Code: Alles auswählen

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

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

Code: Alles auswählen

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

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"

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)

Code: Alles auswählen

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

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

Code: Alles auswählen

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

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