Página 1 de 1

Botao Fechar Aplicacao

Enviado: 31 Jul 2018 às 13:36
por lmedeiros
Criei uma aplicacao com um formulario e varios botoes para executar algumas operacoes, estao todos funcionando.
no final criei um botao fechar para voltar para o modo desenvolvedor mas o mesmo fecha a aplicacao inteira e nao consigo encontrar o comando para parar a aplicacao e voltar para o modo desenvolvedor, preciso disso para poder fazer manutencoes no codigo quando for necessario.

Re: Botao Fechar Aplicacao

Enviado: 31 Jul 2018 às 15:57
por osvaldomp
lmedeiros escreveu:Criei uma aplicacao com um formulario ...
Você está falando de Excel ?

no final criei um botao fechar para voltar para o modo desenvolvedor mas o mesmo fecha a aplicacao ...
Qual o comando que você está utilizando ? Application.Quit ?
O que exatamente você quer dizer com "modo desenvolvedor"? Você se refere a acessar o editor de VBA?

Botao Fechar Aplicacao

Enviado: 31 Jul 2018 às 16:02
por lmedeiros
ja usei esse comando e outros tambem.
criei a aplicacao para abrir direto o formulario sem mostrar as planilhas, e removi o botao fechar e criei um botao para o usuario sair e salvar tudo, mas tenho de fazer manutencao entao criei um botao para ir para o modo desenvolvedor para o processo para que eu possa acessar o form e as planilhas espero ter explicado certo.

Re: Botao Fechar Aplicacao

Enviado: 31 Jul 2018 às 16:13
por osvaldomp
experimente ~~~> Application.Visible = True

Se não resolver sugiro que você coloque aqui o código que está utlilizando para "sair e salvar tudo".

Alternativa ~~~> se no módulo de EstaPasta existe uma macro que oculta as planilhas e carrega o Form ao abrir o arquivo, você poderá manter Shift pressionada enquanto clica para abrir o arquivo, aí aquela macro não será executada.

Botao Fechar Aplicacao

Enviado: 01 Ago 2018 às 11:01
por wesleyribeiro123
Amigo
Boa tarde,

Utilize as seguintes instruções no teu Button:
Código: Selecionar todos
Application.Visible = True
Unload Me
O "Visible = True" exibe a planilha que você ocultou e o "Unload Me" vai descarregar o formulário.
Caso não deseje descarregar o formulário mas quer manipular a planilha enqto o formulário estiver ativo, vá nas Propriedades do formulário e marque a opção ShowModal como True (Verdadeiro).

Espero ter lhe ajudado, caso contrário, recomendo que post uma cópia de tua aplicação para que possamos ser mais assertivo!!!

Re: Botao Fechar Aplicacao

Enviado: 02 Ago 2018 às 10:39
por lmedeiros
criei este modulo na aplicacao para exibir somente o formulario e ocultar as planilhas.

Sub AUTO_OPEN()
Application.Visible = False
lista.Show
End Sub

aassim ele exit o formulario direto quando eu chamo a aplicao, o que eu estou querendo saber e como eu faco um botao no formulario que pare a execucao e volte para a manipulacao dos codigos e das planilhas para que eu possa fazer alteracoes quando for necessario.
abaixo segue o codigo do botao que criei .

Private Sub cmdparar_Click()
Call sair
End Sub
Sub sair()
Sheets("Senha").Activate
Range("A2").Select
Dim senha As String
senha = InputBox("Informe a Senha, Somente Pessoas Autorizadas")
'While ActiveCell <> ""
If senha = ActiveCell Then
MsgBox " voce vai finalizar o processo!!!"
Application.Quit
Application.Visible = True
'lista.Show

Else
MsgBox "Voce Nao tem autorizacao ou a senha esta Incorreta!!!"
Call sair
Exit Sub

End If
'Wend
End Sub

segue imagem do formulario nest link

https://i.imgur.com/I02871A.png

abaixo segue o codigo completo

'*****************************************
Private Sub cbxtipo_Click()
'"******************************************
'* habilita o botao para salvar os dados
'*******************************************
If txttc.Text = "" Then
MsgBox " VOCE TEM DE SELECIONAR NA LISTAGEM UM THINCLIENT PARA SER ALTERADO"
Else
cmdSalva.Enabled = True
End If
End Sub
Private Sub cmdaltera_Click()
If txttc.Text = "" Then
MsgBox " VOCE TEM DE SELECIONAR NA LISTAGEM UM THINCLIENT PARA SER ALTERADO"
Else
txtip.Text = Empty
txtestacao.Text = Empty
txtlinha.Text = Empty
cbxtipo.Value = Empty
Call chama
End If
'**************************************************
'CHAMA ROTINA PARA DIGITAR O IP QUE SERA PROCURADO
'**************************************************
End Sub
Sub chama()
Dim ip As String
Dim rng As Range
ip = InputBox("Informe o IP")
'************************************************
'* COMPARAR O VALOR DIGITADO SE ESTA NA PLANILHA
'************************************************
If Trim(ip) <> "" Then
With Sheets("Cadastro").Range("C:C")
Set rng = .Find(what:=ip, MatchCase:=False)
If Not rng Is Nothing Then
Application.Goto rng, True
MsgBox " ESTE IP JA ESTA EM USO FAVOR DIGITAR NOVAMENTE UM IP VALIDO"
chama
Else
txtip.Text = ip
estacao
End If
End With
End If
End Sub
Sub estacao()
Dim stn As Range
'************************************************
'* COMPARAR O VALOR DIGITADO SE ESTA NA PLANILHA
'************************************************
'* inicio rotina consulta estacao
'************************************************
If Trim(txtip.Text) <> "" Then
With Sheets("Estacoes").Range("A:D")
Set stn = .Find(what:=txtip.Text, MatchCase:=False)
If Not stn Is Nothing Then
Application.Goto stn, True
'MsgBox " IP localizado "
txtestacao.Text = ActiveCell.Offset(0, 1).Select
txtestacao.Text = ActiveCell.Value
txtlinha.Text = ActiveCell.Offset(0, 1).Select
txtlinha.Text = ActiveCell.Value
cbxtipo.SetFocus
Else
MsgBox "ESTE IP NAO FOI LOCALIZADO NA LISTA"
End If
End With
End If
End Sub
Private Sub cmdestacoes_Click()
''******************************************************
'* botao de selecao das linhas para o listbox
'******************************************************
Call Filtra_Estacoes
End Sub
Private Sub cmdestacoes2_Click()
Call Filtra_Estacoes
End Sub
Private Sub cmdfecha_Click()
MsgBox " voce ira finalizar o processo"
ActiveWorkbook.Save
Application.Quit
Workbooks("Lista de Tc1.XLSM").Close
End Sub
Private Sub cmdparar_Click()
Call sair
End Sub
Sub sair()
Sheets("Senha").Activate
Range("A2").Select
Dim senha As String
senha = InputBox("Informe a Senha, Somente Pessoas Autorizadas")
'While ActiveCell <> ""
If senha = ActiveCell Then
MsgBox " voce vai finalizar o processo!!!"
Application.Quit
Application.Visible = True
'lista.Show

Else
MsgBox "Voce Nao tem autorizacao ou a senha esta Incorreta!!!"
Call sair
Exit Sub

End If
'Wend
End Sub
Private Sub cmdSalva_Click()
'**************************************
'* ativa a planilha onde vai gravar
'**************************************
Sheets("Cadastro").Activate
Range("A2").Select
While ActiveCell <> ""
If txttc.Text = ActiveCell Then
ActiveCell.Offset(0, 2).Value = txtip.Text
ActiveCell.Offset(0, 1).Value = txtestacao.Text
ActiveCell.Offset(0, 3).Value = txtlinha.Text
ActiveCell.Offset(0, 4).Value = cbxtipo.Text
ActiveWorkbook.Save
End If
ActiveCell.Offset(1, 0).Activate
Wend
MsgBox " Voce Gravou os Dados Com sucesso !!!"
txttc.Text = Empty
txtip.Text = Empty
txtestacao.Text = Empty
txtlinha.Text = Empty
cbxtipo.Text = Empty
End Sub
Private Sub CommandButton2_Click()
If txttc.Text = "" Then
MsgBox " VOCE TEM DE SELECIONAR NA LISTAGEM UM THINCLIENT PARA SER REMOVIDO"
Else
Call remover
End If
End Sub
Sub remover()
Sheets("Cadastro").Activate
Range("A2").Select
While ActiveCell <> ""
If txttc.Text = ActiveCell Then
ActiveCell.Offset(0, 2).Value = "Not Available"
ActiveCell.Offset(0, 1).Value = "NÃO_ALOCADO"
ActiveCell.Offset(0, 3).Value = "SITE_PRESIDENTE_ALTINO"
ActiveCell.Offset(0, 4).Value = ""
End If
ActiveCell.Offset(1, 0).Activate
Wend
MsgBox " Voce Removeu Com Sucesso !!!"
End Sub
Private Sub CommandButton3_Click()
MsgBox "voce tem de digitar a senha para parar o processo"
End Sub
Sub Filtra_Estacoes()
'*****************************************************************
'* INICIO ROTINA QUE FILTRA OS DADOS DA LIST BOX
'*****************************************************************
Dim linha, linhalistbox As Integer
Dim valor_celula As String
linhalistbox = 0
linha = 2
lstestacoes.Clear
Plan1.Select
With Plan1
While .Cells(linha, 4).Value <> ""
valor_celula = .Cells(linha, 4).Value
If UCase(Left(valor_celula, Len(cmdestacoes.Text))) = UCase(cmdestacoes.Text) Then
valor_celula = .Cells(linha, 2).Value
If UCase(Left(valor_celula, Len(cmdestacoes2.Text))) = UCase(cmdestacoes2.Text) Then
Me.lstestacoes.ColumnWidths = "40;70;150;150;50"
With lstestacoes
.AddItem
.List(linhalistbox, 0) = Plan1.Cells(linha, 1)
.List(linhalistbox, 1) = Plan1.Cells(linha, 3)
.List(linhalistbox, 2) = Plan1.Cells(linha, 2)
.List(linhalistbox, 3) = Plan1.Cells(linha, 4)
.List(linhalistbox, 4) = Plan1.Cells(linha, 5)
End With
linhalistbox = linhalistbox + 1
End If
End If
linha = linha + 1
Wend
End With
End Sub
'*****************************************************************************************************************
Private Sub lsttc_Click()
cmdSalva.Enabled = False
End Sub
Private Sub txttc_Change()
txttc.Text = UCase(txttc.Value)
End Sub
Private Sub UserForm_Activate()
cmdSalva.Enabled = False
Dim lin As Integer
lin = 2
Do Until Sheets("Cadastro").Cells(lin, 1).Value = Empty
lsttc.AddItem Sheets("Cadastro").Cells(lin, 1).Value
lin = lin + 1
Loop
Call Filtra_Estacoes
End Sub
Private Sub lsttc_Change()
cmdSalva.Enabled = False
Dim lin As Integer
lin = 2
Do Until Sheets("Cadastro").Cells(lin, 1).Value = Empty
If Sheets("Cadastro").Cells(lin, 1).Value = lsttc.Value Then
txttc.Value = Sheets("Cadastro").Cells(lin, 1).Value
txtip.Value = Sheets("Cadastro").Cells(lin, 3).Value
txtestacao.Value = Sheets("Cadastro").Cells(lin, 2).Value
txtlinha.Value = Sheets("Cadastro").Cells(lin, 4).Value
cbxtipo.Value = Sheets("Cadastro").Cells(lin, 5).Value
Exit Do
End If
lin = lin + 1
Loop
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Clique no Botao Finalizar Programa Salvando"
End If
End Sub

agradeco desde ja