Página 1 de 1
CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 06 Out 2015 às 18:52
por prcb08
Olá Pessoal,
Preciso URGENTE DE UMA AJUDINHA!!!
Estou desenvolvendo um cadastro cujos dados são registrados em uma pasta de trabalho xlsx (SEM MACROS), a qual será compartilhada.
Ocorre que há no código um comando para abrir esta pasta de trabalho para efetuar os lançamentos. Quando ela está fechada, funciona perfeitamente para o primeiro lançamento de dados. No entanto, para o segundo lançamento no formulário, a pasta de trabalho já está aberta, e o excel pergunta se é para abrir novamente. Esse é o problema.
Como faço para que o programa faça uma análise condicional, para verificar se a pasta está ou não aberta, e prosseguir no códido?
O código inicial ficou assim:
Private Sub cmdSalvar_Click()
Workbooks.Open ("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx")
Worksheets("Plan1").Range("A2").Select
'Seleciona a celula A2
Do
If Not (IsEmpty(ActiveCell)) Then 'Se a célula não estiver vazia
ActiveCell.Offset(1, 0).Select 'Seleciona a celula abaixo
End If 'fim da condição se
Loop Until IsEmpty(ActiveCell) = True 'Faça isso até a célula selecionada seja vazia
EnumeraContatos
ActiveCell.Offset(0, 1).Value = txtData.Text
ActiveCell.Offset(0, 2).Value = txtProcesso.Text
ActiveCell.Offset(0, 3).Value = txtElemento.Text
ActiveCell.Offset(0, 4).Value = txtPrograma.Text
ActiveCell.Offset(0, 5).Value = txtValor.Text
End Sub
Public Sub EnumeraContatos()
If IsNumeric(ActiveCell.Offset(-1, 0)) Then
ActiveCell = ActiveCell.Offset(-1, 0) + 1
Else
ActiveCell = 1
End If
End Sub
Agradeço desde já....
Re: CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 08:42
por Henrique
Esta é uma forma. Entre com o nome do arquivo na função, se estiver aberta vai resultar em VERDADEIRO senão FALSO.
Código: Selecionar todosPublic Function ChecarPlanilha(sNomePlanilha As String) As Boolean
Dim wb As Workbook, bResultado As Boolean
bResultado = False
For Each wb In Application.Workbooks
If InStr(LCase(wb.Name), LCase(sNomePlanilha)) > 0 Then
bResultado = True
Exit For
End If
Next wb
ChecarPlanilha = bResultado
End Function
CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 13:47
por prcb08
Prezado Henrique,
Primeiramente, gostaria de agradecer a pronta resposta.
Gostaria de esclarecer ainda que um novato em VBA, faço algumas coisas, mas tenho alguns problemas em termos de estrutura.
Gostaria de saber se eu coloco a Function que vc indicou no procedimento ou fora dele.
A pasta de trabalho a que me referi fica em outro diretório. O arquivo é : \\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx.
Onde exatamente esse nome extenso entra na Funtion. Voce colocou um "s" na frente da expressão "NomePlanilha". É isso mesmo.
Estou meio enrolado.
Se a Function ficar fora do procedimento, tenho que me referir a ela no procedimento?
Obrigado.
Re: CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 14:17
por Henrique
Primeiramente crie um módulo e copie a função que lhe enviei para lá ou em outro módulo que você esteja trabalhando com seu código VBA.
No seu código faça uma chamada a função para testar se o arquivo está aberto ou não, da seguinte forma
Dim Resp as boolean
Resp = ChecarPlanilha(NOME DA SUA PLANILHA)
if Resp is true then
A PLANILHA ESTÁ ABERTA
Else
A PLANILHA ESTÁ FECHADA
End if
Re: CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 15:22
por prcb08
Prezado Henrique, vc pode verificar onde esta o erro?
O VBA informar que há Erro de compilação: Tipos incompatíveis, se referindo ao "True" da 3ª linha do códido (If Resp Is True Then).
Eis o código abaixo:
Obrigado
Sub cmdSalvar_Click()
Dim Resp As Boolean
Resp = ChecarPlanilha("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx")
If Resp Is True Then
Workbooks("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx").Activate
Else
Workbooks.Open ("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx")
End If
Worksheets("Plan1").Range("A2").Select
'Seleciona a celula A2
Do
If Not (IsEmpty(ActiveCell)) Then 'Se a célula não estiver vazia
ActiveCell.Offset(1, 0).Select 'Seleciona a celula abaixo
End If 'fim da condição se
Loop Until IsEmpty(ActiveCell) = True 'Faça isso até a célula selecionada seja vazia
EnumeraContatos
ActiveCell.Offset(0, 1).Value = txtData.Text
ActiveCell.Offset(0, 2).Value = txtProcesso.Text
ActiveCell.Offset(0, 3).Value = txtElemento.Text
ActiveCell.Offset(0, 4).Value = txtPrograma.Text
ActiveCell.Offset(0, 5).Value = txtValor.Text
End Sub
Public Sub EnumeraContatos()
If IsNumeric(ActiveCell.Offset(-1, 0)) Then
ActiveCell = ActiveCell.Offset(-1, 0) + 1
Else
ActiveCell = 1
End If
End Sub
Public Function ChecarPlanilha()
Dim wb As Workbook, bResultado As Boolean
bResultado = False
For Each wb In Application.Workbooks
If InStr(LCase(wb.Name), LCase("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx")) > 0 Then
bResultado = True
Exit For
End If
Next wb
ChecarPlanilha = bResultado
End Function
Re: CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 15:41
por prcb08
Prezado Henrique,
Eu não sei se me fiz entender quanto a minha necessidade...
O que eu quero exatamente é que o VBA lance valores em uma determinada pasta de trabalho, localizada em outro diretorio. Se essa planilha estiver aberta, ele apenas lança os valores e se estiver fechada ele terá que abrir o arquivo e lançar os valores. Compreendeu? E eu não consigo fazer isso.
Re: CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 16:22
por Henrique
Refaça o seu código conforme a seguir:
Código: Selecionar todosSub cmdSalvar_Click()
Dim Resp As Boolean
Resp = ChecarPlanilha("BD_SCO.xlsx")
If Resp Is True Then
Workbooks("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx").Activate
Else
Workbooks.Open ("\\tjerj204\DGPCF\DEPLO\DIGOR\NOVA PLATAFORMA\BD_SCO.xlsx")
End If
Worksheets("Plan1").Range("A2").Select
'Seleciona a celula A2
Do
If Not (IsEmpty(ActiveCell)) Then 'Se a célula não estiver vazia
ActiveCell.Offset(1, 0).Select 'Seleciona a celula abaixo
End If 'fim da condição se
Loop Until IsEmpty(ActiveCell) = True 'Faça isso até a célula selecionada seja vazia
EnumeraContatos
ActiveCell.Offset(0, 1).Value = txtData.Text
ActiveCell.Offset(0, 2).Value = txtProcesso.Text
ActiveCell.Offset(0, 3).Value = txtElemento.Text
ActiveCell.Offset(0, 4).Value = txtPrograma.Text
ActiveCell.Offset(0, 5).Value = txtValor.Text
End Sub
Public Sub EnumeraContatos()
If IsNumeric(ActiveCell.Offset(-1, 0)) Then
ActiveCell = ActiveCell.Offset(-1, 0) + 1
Else
ActiveCell = 1
End If
End Sub
Public Function ChecarPlanilha(sNomePlanilha As String) As Boolean
Dim wb As Workbook, bResultado As Boolean
bResultado = False
For Each wb In Application.Workbooks
If InStr(LCase(wb.Name), LCase(sNomePlanilha)) > 0 Then
bResultado = True
Exit For
End If
Next wb
ChecarPlanilha = bResultado
End Function
CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 16:33
por prcb08
Ta dando a mesma informação Tipos incompatíveis, se referindo ao "True" da 3ª linha do códido (If Resp Is True Then).
CADASTRO EM OUTRA PASTA DE TRABALHO
Enviado: 07 Out 2015 às 16:36
por prcb08
Prezado Henrique,
Obrigado pela atenção e por tentar resolver o problema.
Desculpe pela minha falta de manejo com o VBA