Não consigo executar o programa dentro da planilha. Somente pela tela do VBA

Question

amigos , preciso de uma luz de vocês.

O caso é o seguinte: sou iniciante no assunto mas fiz um programa no VBA para automatizar algumas tarefas:
A partir de um bd eu exporto um relatório de vendas de diversas lojas e para vários dias com o nome movimento.xls (plan1). A partir dessa planilha....

1) O programa organiza esse relatório (classifica crescente por loja/data);
2) Lança em plan2 o nome dos arquivos das lojas
2) identifica cada uma dessas lojas em plan1 e abre o arquivo ;
4) Em plan1 faz o somatório por loja e por dia e lança os valores no arquivo aberto da loja na planilha FechamCaixa.
4) Após isso, salva, fecha esse arquivo e abre o próximo etc...

O que está ocorrendo é que quando mando executar pelo vba, beleza! faz tudo! abre todas as pastas, e lança os valores. Mas quando executo pelo relatório o programa abre o primeiro arquivo/pasta e para. Não chega a abrir a planilha FechamCaixa.

Já tentei de tudo e não sei resolver o problema e não gostaria de mudar a estrutura do programa. Agradeço desde já...

Option Explicit
Sub PuxaTudo()
'Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim InicioSelecao As Variant
Dim FimSelecao As Variant
Dim Loja As String
Dim NovaLoja As String
Dim NomeArquivo As String
Dim Celula As Range
Dim diaMov As Range
Dim dataInicio As Date
Dim dataFim As Date
Dim formaPagto As String
Dim cartaoDeCredito As Double
Dim cartaoDeDebito As Double
Dim cartaoPresBot As Double
Dim dinheiro As Double
Dim valetroca As Double
Dim cheque As Double
Dim promissoria As Double
Dim convenio As Double
Dim dataMov As Date
Dim novaData As Date
Dim valorBruto As Double
Dim i As Integer
Dim varThatWorkbook As String
Dim nome As String
Dim MacroAuxAbreFechamCx As Variant
Dim Movimento As Workbook

' Macro gravada em 21/10/2010 por Heron Brum
'
' Atalho do teclado: Ctrl+Shif+T
'
Windows("Movimento.xls").Activate

Cells.Select
Selection.RowHeight = 16.75
Range("A:W").UnMerge
' With Selection
' .HorizontalAlignment = xlGeneral
' .VerticalAlignment = xlCenter
' .WrapText = True
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = True
' End With
' Selection.UnMerge
Columns("A:W").EntireColumn.AutoFit
Range("D1").Select
Columns("C:C").ColumnWidth = 3.57
Range("A:C").Delete
' Selection.Delete Shift:=xlToLeft
Range("F:F").Delete
' Selection.Delete Shift:=xlToLeft
Range("H:I").Delete
' Selection.Delete Shift:=xlToLeft
' Range("J:J").Delete
' Selection.Delete Shift:=xlToLeft
Range("L ").Delete
' Selection.Delete Shift:=xlToLeft
Range("A2").Select

Columns("K:K").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("B5").Select

Range("B4:K10420").Sort Key1:=Range("K5"), Order1:=xlAscending, Key2:= _
Range("B5"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal


Sheets("Plan1").Select
Sheets.Add
Sheets("Plan2").Select
Range("A1").Select


Cells(1, 2).Value = "2081 Miranda.xls"
Cells(2, 2).Value = "4780 Amazonas.xls"
Cells(3, 2).Value = "4866 14-II.xls"
Cells(4, 2).Value = "5216 Aquidauana.xls"
Cells(5, 2).Value = "5508 14-I.xls"
Cells(6, 2).Value = "6465 Shopping.xls"
Cells(7, 2).Value = "11121 Corumbá I.xls"
Cells(8, 2).Value = "11376 Zahran.xls"
Cells(9, 2).Value = "11655 Ipe.xls"
Cells(10, 2).Value = "11673 JD Estados.xls"
Cells(11, 2).Value = "11802 WallMart.xls"
Cells(12, 2).Value = "11892 Tamandaré.xls"
Cells(13, 2).Value = "12037 Maxxi.xls"
Cells(14, 2).Value = "12194 R Barbosa.xls"
Cells(15, 2).Value = "12311 Corumbá II.xls"
Cells(16, 2).Value = "12379 Norte-Sul.xls"
Cells(17, 2).Value = "12633 Patio Central.xls"

Cells(1, 5).Value = "2081-MIRANDA-CENTRO-MIRANDA"
Cells(2, 5).Value = "4780-SOLANGE-VILA GOMES-CAMPO GRANDE"
Cells(3, 5).Value = "4866-CGR-CENTRO-CAMPO GRANDE"
Cells(4, 5).Value = "5216-AQUIDAUANA-CENTRO-AQUIDAUANA"
Cells(5, 5).Value = "5508-CAMPO-VILA CIDADE-CAMPO GRANDE"
Cells(6, 5).Value = "6465-RONEU-SHOP CAMPO GRANDE-CAMPOGRANDE"
Cells(7, 5).Value = "11121-RONEU-CENTRO-CORUMBA"
Cells(8, 5).Value = "11376-RONEU-hyper COMPER-CGRANDE"
Cells(9, 5).Value = "11655-SOLANGE-hyper COMPER YPE-CGRANDE"
Cells(10, 5).Value = "11673-SOLANGE-hyper COMPER-CAMPO GRANDE"
Cells(11, 5).Value = "11802-WALL MART-CRUZEIRO-CAMPO GRANDE-MS"
Cells(12, 5).Value = "11892-CAMPO-HIPERCENTER-CAMPO GRANDE-MS"
Cells(13, 5).Value = "12037-HELENITA-CAMPO GRANDE-MS"
Cells(14, 5).Value = "12194-HELENITA -hyper.COMPER-CAMPO G-MS"
Cells(15, 5).Value = "12311-RONEU-CORUMBA-PANOFF"
Cells(16, 5).Value = "12379-SOLANGE-COMPER-NORTE-SUL"
Cells(17, 5).Value = "12633-CGR-CENTRO-PATIO-CAMPO GRANDE"



'Worksheets("plan1").Activate

For i = 1 To 17

Worksheets("plan1").Activate

Loja = Sheets("Plan2").Cells(i, 5).Value
NomeArquivo = Sheets("Plan2").Cells(i, 2).Value
' Loja = Cells(i, 5).Value
Worksheets("plan1").Activate
Range("K1").Select

Set Celula = Cells.Find(What:=Loja, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Celula Is Nothing Then
' MsgBox "Celula Is Nothing"
GoTo pula
End If

Cells.Find(What:=Loja, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

ChDir _
"C:\Documents and Settings\HERBROM\Meus documentos\Boticário\Arquivo Lojas Teste"

Workbooks.Open Filename:=NomeArquivo

'................................................. .............. O PROGRAMA PARA AQUI! NÃO CHEGA A SELECIONAR "FechamCaixa "

Sheets("FechamCaixa").Activate

Worksheets("FechamCaixa").Select

' Application.Wait Now + TimeValue("00:00:25")

Workbooks("Movimento.xls").Worksheets("Plan1").Act ivate

ActiveCell.Offset(0, -9).Select

300:
cartaoDeCredito = 0
cartaoDeDebito = 0
cartaoPresBot = 0
dinheiro = 0
valetroca = 0
cheque = 0
promissoria = 0
convenio = 0

200: dataMov = ActiveCell.Value


ActiveCell.Offset(0, 2).Select
valorBruto = ActiveCell.Value
ActiveCell.Offset(0, 3).Select
formaPagto = ActiveCell.Value

Select Case formaPagto
Case Is = "CARTAO DE CREDITO"
cartaoDeCredito = (cartaoDeCredito + valorBruto)
' MsgBox "no valor cart crédito " & " = " & cartaoDeCredito

Case Is = "CARTAO DE DEBITO"
cartaoDeDebito = (cartaoDeDebito + valorBruto)
' MsgBox "no valor cart dédito " & " = " & cartaoDeDedito

Case "CARTAO PRES BOT"
cartaoPresBot = cartaoPresBot + valorBruto
' MsgBox "no valor cart pres bot " & " = " & cartaoPresBot

Case Is = "DINHEIRO"
dinheiro = dinheiro + valorBruto
Case Is = "VALE TROCA"
valetroca = valetroca + valorBruto
Case Is = "CHEQUE"
cheque = cheque + valorBruto
Case Is = "PROMISSORIA"
promissoria = promissoria + valorBruto
Case Is = "CONVENIO"
convenio = convenio + valorBruto

End Select

ActiveCell.Offset(1, 4).Select
NovaLoja = ActiveCell.Value

If NovaLoja <> Loja Then GoTo 400

ActiveCell.Offset(0, -9).Select
novaData = ActiveCell.Value

If novaData <> dataMov Then

Windows(NomeArquivo).Activate
Worksheets("FechamCaixa").Select

' imprime os totais do dia

Range("B2").Select

Set diaMov = Windows(NomeArquivo).ActiveSheet.Cells.Find(What:= dataMov, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Windows(NomeArquivo).ActiveSheet.Cells.Find(What:= diaMov, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

' diaMov.Select

ActiveCell.Offset(0, 3).Value = cartaoDeCredito
ActiveCell.Offset(0, 4).Value = cartaoDeDebito
ActiveCell.Offset(0, 5).Value = cartaoPresBot
ActiveCell.Offset(0, 6).Value = dinheiro
ActiveCell.Offset(0, 7).Value = valetroca
ActiveCell.Offset(0, 8).Value = cheque
ActiveCell.Offset(0, 9).Value = promissoria
ActiveCell.Offset(0, 10).Value = convenio

Workbooks("Movimento.xls").Worksheets("Plan1").Act ivate

' MsgBox "celula ativa = " & ActiveCell.Address

GoTo 300

End If

GoTo 200

400: Windows(NomeArquivo).Activate
Worksheets("FechamCaixa").Activate

Range("B2").Select

Set diaMov = Windows(NomeArquivo).ActiveSheet.Cells.Find(What:= dataMov, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Windows(NomeArquivo).ActiveSheet.Cells.Find(What:= diaMov, After:= _
ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate


' diaMov.Select

ActiveCell.Offset(0, 3).Value = cartaoDeCredito
ActiveCell.Offset(0, 4).Value = cartaoDeDebito
ActiveCell.Offset(0, 5).Value = cartaoPresBot
ActiveCell.Offset(0, 6).Value = dinheiro
ActiveCell.Offset(0, 7).Value = valetroca
ActiveCell.Offset(0, 8).Value = cheque
ActiveCell.Offset(0, 9).Value = promissoria
ActiveCell.Offset(0, 10).Value = convenio

ActiveWorkbook.SaveAs Filename:=NomeArquivo, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False

Workbooks(NomeArquivo).Close

Workbooks("Movimento.xls").Worksheets("Plan1").Act ivate

GoTo pula

pula:
' MsgBox "ESTOU AQUI "

Next i

'Application.ScreenUpdating = True
End Sub

Answer 1

Olá Herbrom,

 

É bom ver que você está desenvolvendo no VBA. Pelo visto, muito do que aprendeu no VBA (assim como todos nós) foi pelo Gravador de Macros, certo? Pude perceber isso pelos métodos invocados (como Windows.Activate, Cells(linha, coluna).Activate, Sheets(“nome_planilha”).Select e assim por diante.

O Gravador de Macros ajuda muito a entender quais são os comandos em VBA que traduzem ações dos usuários numa Pasta de Trabalho, mas o problema é que ele cumpre os passos ao pé da letra.

Por exemplo: você sabia que é possível, através do VBA, alterar as células de Plan2 através de Plan1?

Um usuário iniciante, se executasse uma rotina em VBA quando a Plan1 estivesse ativada e pretendesse alterar o valor da célula A1 como uma rotina, faria algo do tipo:

Sub Exemplo1a()

    Sheets("Plan1").Select

    Range("A1").Select

    ActiveCell.Value = "Novo valor"

End Sub

 

A rotina acima pode ser simplificada como:

Sub Exemplo1b()

    Sheets("Plan2").Range("A1") = "Novo valor"

End Sub

Perceba que não foi necessário selecionar ou ativar nenhuma célula ou Planilha.

Indo um pouco além, sabia que é possível alterar o valor de uma célula de outra Pasta de Trabalho sem a necessidade de ativá-la? Pois sim, é possível simplificar uma rotina como:

Sub Exemplo2a()

    Workbooks("c:\teste\exemplo.xlsx").Open

    Windows("exemplo").Activate

    Sheets("Plan1").Select

    Range("A1").Select

    ActiveCell.Value = "Novo valor"

    Workbooks("exemplo").Sheets("Plan2").Range("A1") = "Novo valor"

End Sub

Para:

Sub Exemplo2b()

    Workbooks("c:\teste\exemplo.xlsx").Open

    Workbooks("exemplo").Sheets("Plan2").Range("A1") = "Novo valor"

End Sub

A diferença é substancial.

 

Voltando ao seu problema, você está tendo esse erro pelo seguinte motivo:

·       Quando você executa a macro pelo VBA, existem duas janelas abertas: a do Excel e a do VBA. Quando se invoca o método Open em um Workbook, o foco e seleção é atribuído à ele.

·       Quando você executa a macro pelo VBA, existe apenas uma janelas aberta: a do Excel. Quando se invoca o método Open em um Workbook, apenas o foco é atribuído à ele, e a seleção não.

Não seria o jeito mais correto para corrigir seu código, e talvez até não funcione, mas tente trocar o código:

Sheets("FechamCaixa").Activate

Por:

Workbooks(Workbooks.Count).Activate

Sheets("FechamCaixa").Activate

Se tiver a oportunidade, tente criar um código que estaticamente povoe toda sua Planilha.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

BENZADEUS,

Antes quero agradecer seu interesse. De fato com a sugestão que vc deu também não funcionou. Apesar de não entender muito da coisa me deu a impressão que era algo com "foco" - pelo módulo funcionava mas pelas teclas de atalho não! Aí o que eu fiz foi "enganar" o cara. Coloquei a macro num botão e agora está funcionando. Mas ainda estou curioso para saber a solução.

O que é isso: criar um código que estaticamente povoe toda a sua planilha?

 

Valeu,

Obrigado!

Answer 3

Observe que a palavra correta é estaticamente (de estático), e não estatisticamente.

Um código desse tipo é algo semelhante aos códigos Exemplo1b e Exemplo2b, ou seja: não há invocações de métodos para ativar ou selecionar os objetos (os objetos são Planilhas, Pastas de Trabalhos e até mesmo as células).

Isso é feito dando-se nome aos objetos (por exemplo, wbEntrada para uma certa Pasta de Trabalho, wsFérias para uma Planilha de férias e assim por diante) e manipulam-se diretamente, e não indiretamente.

Por exemplo: se em determinado momento em seu código uma janela pop-up do antivírus aparecer seja qual for o motivo, seu código vai falhar, porque o objeto ActiveCell vai gerar um erro, uma vez que não existe ActiveCell quando se foca uma janela que não é Aplicação Excel.

No entanto, se você referenciar à um objeto pelo nome que você a definiu, você pode chamá-la corretamente independentemente de quais janelas estão abertas ou qual é a seleção atual de Pasta de Trabalho/Planilha/Células, como:

MsgBox wb.Name

retornará o nome da Pasta de Trabalho definida por wb, independentemente qual Aplicação eou Pasta de Trabalho estiver aberta.

No entanto,

ActiveWorkBook.Name retornará o nome da Pasta de Trabalho ativa, o que não é sempre confiável.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br