CONSOLIDAR PLANILHAS

[Muca Costa]

Planilhas JAN, FEV, MAR, ABR, MAI, JUN, JUL, AGO, SET, OUT, NOV, DEZEMBRO

 

todas com 18 colunas (de A a R) com dados que podem variar de 1 a 301 linhas cada planilha.

 

Gostaria de uma macro para consolidar todas em uma só com o nome do ANO ATUAL(2015).

 

Porém a consolidação seria só de 12 colunas (de A a L)

 

Alguém poderia me ajudar?

[Muca Costa]

Achei esta solução, só que os dados que contem DATA(Exemplo: 29/01/2015) e HORA(Exemplo: 08:30) aparecem em branco.

 

 

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

 

Sub Consolidar()

dim document as object

dim dispatcher as object

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

dim args3(0) as new com.sun.star.beans.PropertyValue

' obtém a hora do inicio

h1 = TimeValue( Time() )

ExcluirPlanilha

'----------------------------------------------------------------------------------------------------------------------------

document = ThisComponent.CurrentController.Frame

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

args3(0).Name = "Sel"

args3(0).Value = true

'----------------------------------------------------------------------------------------------------------------------------

Dim Plan As String 'Muca

Plan = InputBox("Nome da Planilha Consolidada:", "Informe")'Muca

ThisComponent.Sheets.InsertNewByName(Plan,0)'Muca

'ThisComponent.Sheets.InsertNewByName("2015",0)

ThisComponent.CurrentController.Select(ThisComponent.Sheets(0).GetCellRangeByName("A2"))

'-----------------------------------------------------------------------------------------------------------------------------

for a = 1 to ThisComponent.Sheets.GetCount()-1

ThisComponent.CurrentController.Select(ThisComponent.Sheets(a).GetCellRangeByName("A2"))

dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args3())

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

args1(0).Name = "Nr"

args1(0).Value = 1

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

args1(0).Name = "Flags"

args1(0).Value = "SV"

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args1())

dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args1())

dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())

dispatcher.executeDispatch(document, ".uno:GoLeftToStartOfData", "", 0, args1())

next

'----------------------------------------------------------------------------------------------------------------------------------------

ThisComponent.CurrentController.Select(ThisComponent.Sheets(0).GetCellRangeByName("A2"))

dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args3())

args1(0).Name = "aExtraWidth"

args1(0).Value = 100

dispatcher.executeDispatch(document, ".uno:SetOptimalColumnWidth", "", 0, args1())

rem ----------------------------------------------------------------------

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

args2(0).Name = "ToPoint"

args2(0).Value = "$A$1"

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

Titulos

ExcluirColunas

' obtém a hora do término

h2 = TimeValue( Time() )

' obtém a diferença

dif = h2 - h1

' extrai e exibe as partes

hora = Hour(dif) : min = Minute(dif) :seg = Second(dif)

Print hora;"h ";min;"m ";seg;"s"

msgbox "Consolidado!"

End Sub

 

sub ExcluirPlanilha

rem ----------------------------------------------------------------------

rem define variables

dim document as object

dim dispatcher as object

rem ----------------------------------------------------------------------

rem get access to the document

document = ThisComponent.CurrentController.Frame

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------

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

end sub

 

sub Titulos

rem ----------------------------------------------------------------------

rem define variables

dim document as object

dim dispatcher as object

rem ----------------------------------------------------------------------

rem get access to the document

document = ThisComponent.CurrentController.Frame

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

 

rem ----------------------------------------------------------------------

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

args1(0).Name = "ToPoint"

args1(0).Value = "$A$1"

 

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

rem ----------------------------------------------------------------------

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

args2(0).Name = "StringName"

args2(0).Value = "DIA SEMANA"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args2())

dispatcher.executeDispatch(document, ".uno:JumpToNextUnprotected", "", 0, Array())'Tab

rem ----------------------------------------------------------------------

dim args3(0) as new com.sun.star.beans.PropertyValue

args3(0).Name = "StringName"

args3(0).Value = "DATA"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args3())

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

rem ----------------------------------------------------------------------

dim args4(0) as new com.sun.star.beans.PropertyValue

args4(0).Name = "StringName"

args4(0).Value = "VARA"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args4())

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

rem ----------------------------------------------------------------------

dim args5(0) as new com.sun.star.beans.PropertyValue

args5(0).Name = "StringName"

args5(0).Value = "HORA"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args5())

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

rem ----------------------------------------------------------------------

dim args6(0) as new com.sun.star.beans.PropertyValue

args6(0).Name = "StringName"

args6(0).Value = "PROCESSO"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args6())

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

rem ----------------------------------------------------------------------

dim args7(0) as new com.sun.star.beans.PropertyValue

args7(0).Name = "StringName"

args7(0).Value = "TIPO"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args7())

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

rem ----------------------------------------------------------------------

dim args8(0) as new com.sun.star.beans.PropertyValue

args8(0).Name = "StringName"

args8(0).Value = "CNPJ/CPF"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args8())

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

rem ----------------------------------------------------------------------

dim args9(0) as new com.sun.star.beans.PropertyValue

args9(0).Name = "StringName"

args9(0).Value = "STATUS"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args9())

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

rem ----------------------------------------------------------------------

dim args10(0) as new com.sun.star.beans.PropertyValue

args10(0).Name = "StringName"

args10(0).Value = "OBSERVAÇÃO"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args10())

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

rem ----------------------------------------------------------------------

dim args11(0) as new com.sun.star.beans.PropertyValue

args11(0).Name = "StringName"

args11(0).Value = "SENTENÇA EM"

 

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

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

rem ----------------------------------------------------------------------

dim args12(0) as new com.sun.star.beans.PropertyValue

args12(0).Name = "StringName"

args12(0).Value = "PRAZO SENTENÇA"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args12())

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

rem ----------------------------------------------------------------------

dim args13(0) as new com.sun.star.beans.PropertyValue

args13(0).Name = "StringName"

args13(0).Value = "DIAS"

 

dispatcher.executeDispatch(document, ".uno:EnterString", "", 0, args13())

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

 

end sub

 

sub ExcluirColunas

Dim oSheet ' Folha Calc contendo dados para ordener.

Dim oCellRange ' Área a ser selecionada.

dim document as object

dim dispatcher as object

oSheet = ThisComponent.getCurrentController.getActiveSheet()'Planilha Ativa

REM Selecione as células a serem classificadas

oCellRange = oSheet.getCellRangeByName("M1:R5001")'Colunas

REM Selecione Colunas

ThisComponent.getCurrentController.select(oCellRange)

REM Deleta colunas

document = ThisComponent.CurrentController.Frame

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

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

end Sub

[Muca Costa]

Resolvido: Sub Consolidar e Sub Limpar, oriundas do Excel; Sub formatar do Calc

 

REM  *****  BASIC  *****
Option VBASupport 1

Sub Consolidar()

Sheets(1).Range("A2:L5001").ClearContents
plans = Sheets.Count
linha = 2

For n = 2 To plans
    lin = 2
    Do Until Sheets(n).Cells(lin, 1) = ""
       
       Sheets(1).Cells(linha, 1) = Sheets(n).Cells(lin, 1)
       Sheets(1).Cells(linha, 2) = Sheets(n).Cells(lin, 2)
       Sheets(1).Cells(linha, 3) = Sheets(n).Cells(lin, 3)
       Sheets(1).Cells(linha, 4) = Sheets(n).Cells(lin, 4)
       Sheets(1).Cells(linha, 5) = Sheets(n).Cells(lin, 5)
       Sheets(1).Cells(linha, 6) = Sheets(n).Cells(lin, 6)
       Sheets(1).Cells(linha, 7) = Sheets(n).Cells(lin, 7)
       Sheets(1).Cells(linha, 8) = Sheets(n).Cells(lin, 8)
       Sheets(1).Cells(linha, 9) = Sheets(n).Cells(lin, 9)
       Sheets(1).Cells(linha, 10) = Sheets(n).Cells(lin, 10)
       Sheets(1).Cells(linha, 11) = Sheets(n).Cells(lin, 11)     
       Sheets(1).Cells(linha, 12) = Sheets(n).Cells(lin, 12)         
       
       'Sheets(1).Cells(linha, 13).Font.ColorIndex = n + 1
       'Sheets(1).Cells(linha, 13) = Sheets(n).Name
       
       lin = lin + 1
       
       linha = linha + 1
    
    Loop
Next
    Formatar
    msgbox "Consolidado!"

End Sub

Sub Limpar()
    Sheets(1).Range("A2:L5001").ClearContents
End Sub

sub Formatar
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = "$B$2:$B$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
    
rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$D$2:$D$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 40
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$I$2:$I$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$J$2:$J$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$K$2:$K$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

end sub