[Solved] Creating A Border In Calc Using VB

Creating a macro - Writing a Script - Using the API (OpenOffice Basic, Python, BeanShell, JavaScript)
Post Reply
Manikandan
Posts: 44
Joined: Tue Jun 21, 2011 11:40 am

[Solved] Creating A Border In Calc Using VB

Post by Manikandan »

Dear all,

I need a help to create a table border for range of cells in open office calc file using visual basic application. I have written the below code. It does not work. Could you please any one help to do this.

VB Code:

Code: Select all

 Dim oSM As Object, SavePath As String
    Dim oDesk As Object         'Objects from the API
    Dim oDoc As Object          'Objects from the API
    Dim oSheet As Object        'Objects from the API
    Dim oItalic As Object
    Dim arg()
    Dim I As Integer, J As Integer
        
    Set oSM = CreateObject("com.sun.star.ServiceManager")
    Set oDesk = oSM.CreateInstance("com.sun.star.frame.Desktop")
    Set oDoc = oDesk.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg())
    Set oSheet = oDoc.getSheets().getByIndex(0)
    SavePath = App.Path & "\SampleCalcfile.ods"
    SavePath = ConvertToUrl(SavePath)
    
    For I = 0 To Val(txtRows.Text) - 1
        For J = 0 To Val(txtCols.Text) - 1
            Call oSheet.getCellByPosition(J, I).setString("Row:" & I + 1 & ",Col:" & J + 1)
        Next J
    Next I
    
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharWeight = 150 'Bold
    oSheet.getCellRangeByPosition(0, 1, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharColor = 16711680 ' color
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CellBackColor = RGB(0, 220, 240) 'cell back color
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharHeight = 15 'Font size
    
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharFontName = "Calibri" 'font name
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharPosture = 2 'Italic
    oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharUnderLine = 1 'UnderLine

    '// Set Fixed width to all columns
    Dim range As Object
    Set range = oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0)
        Dim columns As Object
        Set columns = range.getColumns()
        For I = 0 To Val(txtCols.Text) - 1
            columns.getByIndex(I).optimalWidth = True
        Next
        '//
              
         

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).HoriJustify = 2 'Horizontal Alignment center
      
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.Color = RGB(255, 0, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.InnerLineWidth = 18
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.OuterLineWidth = 36
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.LineDistance = 24
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsTopLineValid = True


       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.BottomLine.Color = RGB(255, 0, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.BottomLine.InnerLineWidth = 18
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.BottomLine.OuterLineWidth = 36
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.BottomLine.LineDistance = 24
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsBottomLineValid = True

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.LeftLine.Color = RGB(255, 0, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.LeftLine.InnerLineWidth = 18
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.LeftLine.OuterLineWidth = 36
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.LeftLine.LineDistance = 24
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsLeftLineValid = True

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.RightLine.Color = RGB(255, 0, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.RightLine.InnerLineWidth = 18
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.RightLine.OuterLineWidth = 36
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.RightLine.LineDistance = 24
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsRightLineValid = True

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.HorizontalLine.Color = RGB(0, 255, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.HorizontalLine.InnerLineWidth = 1
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.HorizontalLine.OuterLineWidth = 0
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.HorizontalLine.LineDistance = 0
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsHorizontalLineValid = True

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.VerticalLine.Color = RGB(0, 0, 255)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.VerticalLine.InnerLineWidth = 0
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.VerticalLine.OuterLineWidth = 0
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.VerticalLine.LineDistance = 0
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.IsVerticalLineValid = True

Call oDoc.storeToURL(SavePath, arg())
        oDoc.Close (True)
        Set oDoc = Nothing
        MsgBox "Completed"
        End
Thanks in Advance.

Regards,

Manikandan
Last edited by Manikandan on Tue Jul 05, 2011 9:05 am, edited 4 times in total.
Openoffice.org 2.3, Windows XP
Top
B Marcelly
Volunteer
Posts: 1160
Joined: Mon Oct 08, 2007 1:26 am
Location: France, Paris area

Re: Creating A Border In Calc Using VB

Post by B Marcelly »

Hi,

Code: Select all

       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.Color = RGB(255, 0, 0)
       oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder.TopLine.InnerLineWidth = 18
'   etc...
Bad VB programming habits...
  • OOo programming does not offer code completion, so you are not helped writing like this.
  • Any error in any term of the expression will be difficult to find.
  • Reading all these code lines, it is not obvious if you work on the same cell zone or not.
  • Your code uselessly repeats the same work to get the same zone, because you don't use intermediate variables.
  • And finally you cannot, with OOo API, directly modify an element of a structure contained in structure contained in a property of an object.
Use intermediate variables like this:

Code: Select all

Dim myZone As Object, myBorder As Object, myBorderLine As Object
' -----
Set myZone = oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1)
Set myBorder = myZone.TableBorder

Set myBorderLine = myBorder.TopLine ' get the structure
myBorderLine.Color = RGB(255, 0, 0)
myBorderLine.InnerLineWidth = 18
myBorderLine.OuterLineWidth = 36
myBorderLine.LineDistance = 24
myBorder.TopLine = myBorderLine ' copy the modified structure
myBorder.IsTopLineValid = True

Set myBorderLine = myBorder.BottomLine ' get the structure
' ... modify the structure...
myBorder.BottomLine = myBorderLine ' copy the modified structure
myBorder.IsBottomLineValid = True

' --- same for other lines ----

' --------- finally copy the complex border ---------
myZone.TableBorder = myBorder
Bernard

OpenOffice.org 1.1.5 / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5
MS-Windows 7 Home SP1
Top
Manikandan
Posts: 44
Joined: Tue Jun 21, 2011 11:40 am

Re: Creating A Border In Calc Using VB

Post by Manikandan »

Dear All,

I found the solution for the above problem. I changed the code as below. It works now.

Dim oSM As Object, SavePath As String
Dim oDesk As Object 'Objects from the API
Dim oDoc As Object 'Objects from the API
Dim oSheet As Object 'Objects from the API
Dim oItalic As Object
Dim arg()
Dim I As Integer, J As Integer

Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oDesk = oSM.CreateInstance("com.sun.star.frame.Desktop")
Set oDoc = oDesk.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg())
Set oSheet = oDoc.getSheets().getByIndex(0)
SavePath = App.Path & "\SampleCalcfile.ods"
SavePath = ConvertToUrl(SavePath)

For I = 0 To Val(txtRows.Text) - 1
For J = 0 To Val(txtCols.Text) - 1
Call oSheet.getCellByPosition(J, I).setString("Row:" & I + 1 & ",Col:" & J + 1)
Next J
Next I

oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharWeight = 150 'Bold
oSheet.getCellRangeByPosition(0, 1, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharColor = 16711680 ' color
oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CellBackColor = RGB(0, 220, 240) 'cell back color
oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharHeight = 15 'Font size

oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharFontName = "Calibri" 'font name
oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).CharPosture = 2 'Italic
oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).CharUnderLine = 1 'UnderLine

'// Set Fixed width to all columns
Dim range As Object
Set range = oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0)
Dim columns As Object
Set columns = range.getColumns()
For I = 0 To Val(txtCols.Text) - 1
columns.getByIndex(I).optimalWidth = True
Next
'//
oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, 0).HoriJustify = 2 'Horizontal Alignment center

Dim aBorder As Object, aLineBorder As Object, aLineBorder1 As Object
Set aLineBorder = oSM.Bridge_GetStruct("com.sun.star.table.BorderLine")
aLineBorder.Color = RGB(0, 0, 255)
aLineBorder.InnerLineWidth = 0
aLineBorder.OuterLineWidth = 26
aLineBorder.LineDistance = 24

Set aLineBorder1 = oSM.Bridge_GetStruct("com.sun.star.table.BorderLine")
aLineBorder.Color = RGB(0, 0, 255)
aLineBorder.InnerLineWidth = 0
aLineBorder.OuterLineWidth = 0
aLineBorder.LineDistance = 0
Set aBorder = oSM.Bridge_GetStruct("com.sun.star.table.TableBorder")
aLineBorder.OuterLineWidth = 50
aLineBorder.InnerLineWidth = 0
aLineBorder.Color = 0
aBorder.IsTopLineValid = 1
aBorder.IsBottomLineValid = 1
aBorder.IsLeftLineValid = 1
aBorder.IsRightLineValid = 1
aBorder.IsHorizontalLineValid = 1
aBorder.IsVerticalLineValid = 1

aBorder.TopLine = aLineBorder
aBorder.BottomLine = aLineBorder
aBorder.LeftLine = aLineBorder
aBorder.RightLine = aLineBorder
aBorder.HorizontalLine = aLineBorder1
aBorder.VerticalLine = aLineBorder1

oSheet.getCellRangeByPosition(0, 0, Val(txtCols.Text) - 1, Val(txtRows.Text) - 1).tableBorder = aBorder

Call oDoc.storeToURL(SavePath, arg())
oDoc.Close (True)
Set oDoc = Nothing
MsgBox "Completed"
End

Regards,

Manikandan
Last edited by Manikandan on Tue Jul 05, 2011 8:57 am, edited 1 time in total.
Openoffice.org 2.3, Windows XP
Top
Manikandan
Posts: 44
Joined: Tue Jun 21, 2011 11:40 am

Re: Creating A Border In Calc Using VB

Post by Manikandan »

HI Marcelly ,

Many thanks for your comments and solution.

Regards,

Manikandan.
Openoffice.org 2.3, Windows XP
Top
Post Reply

Return to “Macros and UNO API”