Ask Your Question
0

[SOLVED] How to ADD Print area in Calc StarBasic Macro

asked 2020-08-27 11:30:40 +0100

Arrowman gravatar image

updated 2020-10-02 13:13:35 +0100

Hello, I can set Print Area as below. I can't find how to add Print area, does someone know? Thanks!

Dim printRange(0) As New com.sun.star.table.CellRangeAddress
Dim oSheet As Object
Dim oSheetIndex As Integer

oSheet = ThisComponent.Sheets.GetByIndex(0)
oSheetIndex = oSheetDestination.RangeAddress.Sheet

' prepare for set up print area
printRange(0).Sheet = oSheetIndex
printRange(0).StartColumn = 0
printRange(0).StartRow = 0
printRange(0).EndColumn = 5
printRange(0).EndRow = 5

' set a print area
oSheet.setPrintAreas( printRange() )

'oSheet.addPrintArea( printRange() ) - ERROR: function doesn't exist
edit retag flag offensive close merge delete

1 Answer

Sort by » oldest newest most voted
2

answered 2020-08-27 17:27:27 +0100

Zizi64 gravatar image

updated 2020-08-28 13:00:37 +0100

REM BASIC

Option explicit

sub PrintRange

 Dim oDoc as object
 Dim oSheet As Object

 Dim FirstPrintRange As New com.sun.star.table.CellRangeAddress
 Dim ExistingArea as New com.sun.star.table.CellRangeAddress 
 Dim AreaToAdd as New com.sun.star.table.CellRangeAddress 

 Dim iPrAreasCount as Integer
 Dim aPrintAreas() as Variant
 Dim isAreaExist as boolean
 Dim i as integer


    oDoc = ThisComponent
    oSheet = oDoc.Sheets.GetByIndex(0)


    aPrintAreas = oSheet.PrintAreas
    If uBound(aPrintAreas) = -1 then
        Print "There is not any PrinRange set on this sheet!"
        Redim aPrintAreas(0) as Variant

        ' prepare for set up the first print area '
        FirstPrintRange.Sheet = 0
        FirstPrintRange.StartColumn = 0
        FirstPrintRange.StartRow = 0
        FirstPrintRange.EndColumn = 5
        FirstPrintRange.EndRow = 5

        ' set a print area '
        aPrintAreas(0) = FirstPrintRange
        oSheet.setPrintAreas(aPrintAreas())
    end if  






    ' reread: '
    aPrintAreas = oSheet.PrintAreas 
    iPrAreasCount = uBound(aPrintAreas)-lBound(aPrintAreas)+1
        Print "Existing PrintAreas Count =", iPrAreasCount
    Dim aExtendedPrintAreas(iPrAreasCount) as Variant

    AreaToAdd.Sheet = 0
    AreaToAdd.StartColumn = 0
    AreaToAdd.StartRow = 20
    AreaToAdd.EndColumn = 5
    AreaToAdd.EndRow = 35

    isAreaExist = false
    for i = lBound(aPrintAreas) to uBound(aPrintAreas)

        ExistingArea = aPrintAreas(i)
        If  (AreaToAdd.Sheet = ExistingArea.Sheet) and _
            (AreaToAdd.StartColumn = ExistingArea.StartColumn) and _
            (AreaToAdd.StartRow = ExistingArea.StartRow) and _
            (AreaToAdd.EndColumn = ExistingArea.EndColumn) and _
            (AreaToAdd.EndRow = ExistingArea.EndRow) then
            Print "The AreaToAdd exists now!"
            isAreaExist = true
        else 
            aExtendedPrintAreas(i) = aPrintAreas(i)
        end if
    next i

    If isAreaExist = false then
        ' set the extended print area '
        aExtendedPrintAreas(iPrAreasCount) = AreaToAdd
        oSheet.setPrintAreas(aExtendedPrintAreas())
        ' reread: '
        aPrintAreas = oSheet.PrintAreas 
        iPrAreasCount = uBound(aPrintAreas)-lBound(aPrintAreas)+1
        Print "There are", iPrAreasCount, "defined Print Ranges now"
    end if

end sub
edit flag offensive delete link more

Comments

@Zizi64: a hint related to quirks of the site's engine: it considers everything starting with ' as string until another ' is found, even across multiple lines. So in order to have a descent code highlighting, a trick is useful to end comments also with ', like

' this is a comment ending with apostrophe '
next

... or using two apostrophes in the beginning - but then the comments will not be colored differently:

'' this is a comment
next
Mike Kaganski gravatar imageMike Kaganski ( 2020-08-28 12:08:46 +0100 )edit

Thank you. I just fixed the comment lines to ' this format ' , but they are not colorized now in my Firefox.

(ahhh, it must refresh the page in the browser after sendig an edited answer... The comments are colorized now.)

Zizi64 gravatar imageZizi64 ( 2020-08-28 13:05:14 +0100 )edit

Yes this is yet another quirk of this site :-D

Mike Kaganski gravatar imageMike Kaganski ( 2020-08-28 13:10:33 +0100 )edit
Login/Signup to Answer

Question Tools

1 follower

Stats

Asked: 2020-08-27 11:30:40 +0100

Seen: 61 times

Last updated: Oct 02