Biblioteca de exportação do BR Office CALC

'bs_BrOffice_Calc:

%REM
Library bs_BrOffice_Calc
Biblioteca criada para armazenar as funções utilizadas para montagem de relatórios na ferramenta BrOffice.org Calc
%END REM
Option Public
'Option Declare


Dim objServiceManager As Variant
Dim objCoreReflection As Variant
Dim StarDesktop As Variant
Dim dispatcher As Variant
Dim sUrl As Variant

Dim oDoc As Variant
Dim frame As Variant
Dim oPlanilha As Variant
Dim oCelula As Variant
Dim oCellRange As Variant
Dim oAddr As Variant
Dim border
Dim oCursor As Variant
Dim vEnd As Variant

Dim Charts As Variant
Dim Chart
Dim Rect As Variant
Dim classSize As Variant

Dim oText
Dim oField

Dim IntCelula() As Integer 'Array de inteiros das Linhas e Colunas de todas as Abas (PRIMEIRA DIMENSAO - POSIÇÃO 0 PARA LINHA E 1 PARA COLUNA)
Dim strListNomeCelula List As String 'Armazena as letras correspondentes a celula




%REM
Sub CALC_Initialize
Description: Comments for Sub
%END REM
Sub CALC_Initialize

Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
Set StarDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set dispatcher = objServiceManager.createInstance("com.sun.star.frame.DispatchHelper")

'Cria um novo documento do CALC
Dim args(0)
Set args(0) = CALC_makePropertyValue("Hidden", True)

sUrl = "private:factory/scalc"
Set oDoc = StarDesktop.loadComponentFromURL(sUrl, "_blank", 0, args())

Set oPlanilha = oDoc.getSheets().getByIndex(0)

Set frame = oDoc.CurrentController.Frame
End Sub

Function CALC_makePropertyValue(sName As String, vValue) As Variant

Dim vStruct
Set vStruct = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
vStruct.name = sName
vStruct.value = vValue
Set CALC_makePropertyValue = vStruct

End Function

%REM
Description: Comments for Sub
Monta o cabeçalho com os valors dos títulos das colunas
Parâmetro de entrada:
arrayTitulo -> Array com os títulos
coluna -> Coluna inicial onde o primeiro título será inserido
linha -> Linha inicial onde o primeiro título será inserido
%END REM
Sub CALC_montaCabecalho(arrayTitulo As Variant, coluna As Long, linha As Long)

Dim i As Long

i = coluna

Forall titulo In arrayTitulo
Call CALC_preencheCelula(i, linha, "String", Cstr(titulo), 0, True)
i = i + 1
End Forall

End Sub


Sub CALC_preencheCelula(coluna As Long, linha As Long, tipo As String, strTexto As String, dblNum As Double, flagBold As Boolean)
%REM
Description: Comments for Sub
Monta o gráfico conforme tabela montada
Parâmetros de entrada:
coluna -> Coluna onde o valor será inserido
linha -> Linha onde o valor será inserido
tipo -> tipo de dado (pode ser 'String', 'Number' ou 'Formula'
strTexto -> String a ser inserida na célula, passar "" caso seja do tipo 'Integer'
startRow -> Valor a ser inserido na célula, passar 0 caso seja do tipo 'String'
flagBold -> Indicação se o valor será negrito. True or False
%END REM

Set oCelula = oPlanilha.getCellByPosition(coluna, linha)

Select Case tipo
Case "String": oCelula.setString(strTexto)
Case "Number": oCelula.setValue(dblNum)

Case "Percentual":
oCelula.setValue(dblNum)
oCelula.NumberFormat = 11 'Formata para %

Case "Formula": oCelula.SetFormula(strTexto)
End Select

If flagBold Then
oCelula.CharWeight = 150
End If

Call CALC_setBorder()
Call CALC_autoFit(1)
'oCelula.isTextWrapped = True


End Sub

Sub CALC_setBorder()

On Error Goto trataerro

'Parâmetros de configuração de borda das células
Set border = CALC_createStruct("com.sun.star.table.BorderLine")
border.Color = 0
border.InnerLineWidth = 1
border.OuterLineWidth = 1
border.LineDistance = 0

oCelula.setPropertyValue "LeftBorder", border
oCelula.setPropertyValue "RightBorder", border
oCelula.setPropertyValue "TopBorder", border
oCelula.setPropertyValue "BottomBorder", border

Exit Sub
trataerro:
Msgbox "Erro - Rotina:'setBorder' - Linha: " & Erl & " Tipo: " & Error , 16 , "Operação Cancelada!"
Exit Sub
End Sub

%REM
Sub CALC_formataFontPlanilha
Description: Comments for Sub
Define qual será o nome e tamanho da fonte utilizada
Parâmetros de entrada:
fontSize -> Tamanho da fonte que será utilizada
fontName -> Define o nome da fonte que será utilizada
fontColorRGB -> Código RGB. Ex: "#FFFFFF"

Obs. Para verificar a paleta de cores, acesse a page "Paleta de Cores"
%END REM
Sub CALC_formataFontPlanilha(fontSize As Integer, fontName As String, fontColorRGB As String)

Set oCursor = oPlanilha.createCursor()
oCursor.gotoEndOfUsedArea(False)
Set vEnd = oCursor.getRangeAddress()

Set oCellRange = oPlanilha.getCellRangeByPosition(0, 0, 100, vEnd.EndRow)
oCellRange.CharHeight = fontSize
oCellRange.CharFontName = fontName
oCellRange.CharColor = UTIL_Hex2Dec(fontColorRGB)

End Sub

Sub CALC_montaGrafico(tipoGrafico As String, posX As Long, posY As Long, startColumn As Long, startRow As Long, endColumn As Long, endRow As Long, strYAxisTitle As String, intPlan As Integer)

'MsgBox "CALC"
'Stop

%REM
Description: Comments for Sub
Monta o gráfico conforme tabela montada
Parâmetros de entrada:
tipoGrafico -> "B (barra)", "L (linha)" e "P (pizza)"
posX -> Posicionamento do gráfico na tela
posY -> Posicionamento do gráfico na tela
startColumn -> Coluna inicial da tabela
startRow -> Linha inicial da tabela
endColumn -> Coluna final da tabela
endRow -> Linha final da tabela
strYAxisTitle -> Título do eixo do gráfico
%END REM

Dim nomeGrafico As String

Set Rect = CALC_createStruct("com.sun.star.awt.Rectangle")'aStruct

Dim RangeAddress(0)
Set RangeAddress(0) = CALC_createStruct("com.sun.star.table.CellRangeAddress") 'aStruct

Set Charts = oDoc.getSheets().getByIndex(intPlan).Charts

Rect.X = posX
Rect.Y = posY
Rect.Width = 10000
Rect.Height = 7000
RangeAddress(0).Sheet = 0
RangeAddress(0).StartColumn = startColumn
RangeAddress(0).StartRow = startRow
RangeAddress(0).EndColumn = endColumn
RangeAddress(0).EndRow = endRow

nomeGrafico = "MyChart" + Cstr(Rnd)
Call Charts.addNewByName(nomeGrafico, Rect, RangeAddress(), True, True)
Set Chart = Charts.getByName(nomeGrafico).embeddedObject

If tipoGrafico = "B" Then
Set Chart.Diagram = Chart.createInstance("com.sun.star.chart.BarDiagram")
Elseif tipoGrafico = "L" Then
Set Chart.Diagram = Chart.createInstance("com.sun.star.chart.LineDiagram")
Elseif tipoGrafico = "P" Then
Set Chart.Diagram = Chart.createInstance("com.sun.star.chart.PieDiagram")
Chart.Diagram.DataRowSource = 0 '0 = ROWS; 1 = COLUMNS
End If

Chart.HasMainTitle = True
Chart.Title.String = "Representação Gráfica"
Chart.HasLegend = True
Chart.Legend.CharHeight = 7
Chart.Diagram.HasYAxisTitle = True
Chart.Diagram.YAxisTitle.String = strYAxisTitle
Chart.Diagram.DataCaption = 1 'True - percentual e legenda; '4 - legenda

End Sub

Function CALC_createStruct(strTypeName)
Dim aStruct

Set classSize = objCoreReflection.forName(strTypeName)
classSize.createObject aStruct

Set CALC_createStruct = aStruct

End Function

%REM
Sub CALC_Terminate
Description: Comments for Sub
%END REM
Sub CALC_Terminate()
Set objServiceManager = Nothing
Set objCoreReflection = Nothing
Set StarDesktop = Nothing
Set dispatcher = Nothing
Set oDoc = Nothing
Set classSize = Nothing
End Sub

%REM
Sub CALC_autoFit
Description: Comments for Sub
Seleciona a planilha para ajustar o tamanho das colunas de acordo com o tamanho dos valores
Parâmetro de entrada:
intPlan -> Número da planilha, ex. Planilha 1 (0)
%END REM
Sub CALC_autoFit(intPlan As Integer)
Set oPlanilha = oDoc.getSheets().getByIndex(intPlan - 1)
oPlanilha.columns.optimalwidth = True
'oPlanilha.columns.wraptext = true
End Sub

%REM
Sub CALC_insertTable
Description: Comments for Sub
Insere link para o documento do banco de dados
Parâmetros de entrada:
strHiperLink -> Link para o documento.
"Notes://" + Server.Common + "/" + bd.ReplicaID + "/vi_All/" + + doc.UniversalID
coluna -> Coluna que indicará a posição do link
linha -> Linha que indicará a posição do link
%END REM
Sub CALC_insertHiperLink(strUrl As String, coluna As Long, linha As Long)

Set oCelula = oPlanilha.getCellByPosition(coluna, linha)
oCelula.setString("Link")

REM Create a URL Text field
Set oField = oDoc.createInstance("com.sun.star.text.TextField.URL")
oField.Representation = "Link"
oField.URL = strUrl

oCelula.setString("")
Set oText = oCelula.getText()
Call oText.insertTextContent(oText.createTextCursor(), oField, False)

End Sub

%REM
Sub CALC_autoFiltro
Description: Comments for Sub
%END REM
Sub CALC_autoFiltro(colunaInicial As Long, linhaInicial As Long, colunaFinal As Long, linhaFinal As Long)

Set oCellRange = oPlanilha.getCellRangeByPosition(colunaInicial, linhaInicial, colunaFinal, linhaFinal)
Set oAddr = oCellRange.getRangeAddress()
Call oDoc.DatabaseRanges.addNewByName("dbRange", oAddr)

Set oCellRange = oDoc.DatabaseRanges.getByName("dbRange")
oCellRange.AutoFilter = True

End Sub

%REM
Sub CALC_showFile
Description: Comments for Sub
%END REM
Sub CALC_showFile()
oDoc.getCurrentController().getFrame().getContainerWindow().setVisible(True)
End Sub

%REM
Funtion UTIL_Hex2Dec
Description: Comments for Function
Essa função faz a conversão de um número hexadecimal para decimal
%END REM

Function UTIL_Hex2Dec( hexadecimal )
Dim n, aux, valores, decimal, fator

'Busca e retira o caracter "#" do código RGB informado
Dim pos As Integer
pos = Instr(hexadecimal, "#")

If pos > 0 Then
hexadecimal = Right(hexadecimal, Len(hexadecimal) - pos)
End If

'Conversão HEX to DEC
valores = "0123456789ABCDEF"
n = 1
decimal = 0

For n = Len( hexadecimal ) To 1 Step -1
fator = 16 ^ ( Len( hexadecimal ) - n )
aux = Instr( valores, Mid( hexadecimal, n, 1 ) ) - 1
decimal = decimal + ( aux * fator )
Next

UTIL_Hex2Dec = decimal
End Function

%REM
Sub CALC_AddSheet
Description: Comments for Sub
OBJETIVO: Adiciona um determinado valor a uma célula dentro do arquivo no Excel
PARÂMETROS: total [Integer] - Quantidade de Planilhas a inserir.
RETORNO: Nenhum
%END REM
Sub CALC_addSheet(total As Integer)
Dim i As Integer
For i = 0 To total -1
oDoc.Sheets.insertNewByName "Planilha_" + Cstr(i),1
Next
End Sub

Sub CALC_selectSheet(intNum As Integer)
'Posiciona o cursor na pasta solicitada dentro de uma planilha
Set oPlanilha = oDoc.getSheets().getByIndex(intNum)
Set oCelula = oPlanilha.getCellByPosition(0, 0)
End Sub

%REM
'OBJETIVO: Adiciona um determinado valor a uma célula dentro do arquivo no Excel
'PARÂMETROS: total [Integer] - Quantidade de Planilhas a inserir.
' texto [String] - Valor para qual será renomeado
'RETORNO: Nenhum
%END REM
Sub CALC_renameSheet(total As Integer, texto As String)

Dim i As Integer

For i = 1 To total
Set oPlanilha = oDoc.getSheets().getByIndex(i - 1)
Call oPlanilha.setName(texto + Cstr(i))
Next

End Sub

%REM
Function CALC_GetCellValue
Description: Comments for Function
%END REM
Function CALC_getCellValue(intLin As Long, intCol As Long) As String
Set oCelula = oPlanilha.getCellByPosition(intCol, intLin)
CALC_getCellValue = oCelula.getString()

End Function



%REM
Function CALC_getCellName
Description: Comments for Function
%END REM
Function CALC_getCellName(nLeft As Long, nTop As Long, nRight As Long, nBottom As Long) As String


Set oCelula = oPlanilha.getCellRangeByPosition(1, 1, 2, 1)
Set oAddr = oCelula.getRangeAddress()


End Function

%REM
Sub UTIL_InicializaVetorColuna
Description: Comments for Sub
%END REM
Sub UTIL_InicializaVetorColuna

strListNomeCelula("0") = "A"
strListNomeCelula("1") = "B"
strListNomeCelula("2") = "C"
strListNomeCelula("3") = "D"
strListNomeCelula("4") = "E"
strListNomeCelula("5") = "F"
strListNomeCelula("6") = "G"
strListNomeCelula("7") = "H"
strListNomeCelula("8") = "I"
strListNomeCelula("9") = "J"
strListNomeCelula("10") = "K"
strListNomeCelula("11") = "L"
strListNomeCelula("12") = "M"
strListNomeCelula("13") = "N"
strListNomeCelula("14") = "O"
strListNomeCelula("15") = "P"
strListNomeCelula("16") = "Q"
strListNomeCelula("17") = "R"
strListNomeCelula("18") = "S"
strListNomeCelula("19") = "T"
strListNomeCelula("20") = "U"
strListNomeCelula("21") = "V"
strListNomeCelula("22") = "W"
strListNomeCelula("23") = "X"
strListNomeCelula("24") = "Y"
strListNomeCelula("25") = "Z"

End Sub

%REM
Function UTIL_RecuperaLetraColuna
Description: Comments for Function
%END REM
Function UTIL_RecuperaLetraColuna(intCol As Long)
UTIL_RecuperaLetraColuna = strListNomeCelula(intCol)
End Function

%REM
Sub CALC_merge
Description: Comments for Sub
Efetua o merge de células no BrOffice_Calc

Parâmetros:
intPlanilha -> Número da planilha, '0 (zero)' para planilha 1
intColInicio -> Coluna de início para montar o range
intLinhaInicio -> Linha de início para montar o range
intColFim -> Coluna final para montar o range
intLinhaFim -> Linha final para montar o range
%END REM
Sub CALC_mergeCells(intPlanilha As Long, intColInicio As Long, intLinhaInicio As Long, intColFim As Long, intLinhaFim As Long)
Set oPlanilha = oDoc.getSheets().getByIndex(intPlanilha)
Call oPlanilha.getCellRangeByPosition(intColInicio, intLinhaInicio, intColFim, intLinhaFim).Merge(True)
End Sub
Sub Initialize

End Sub