Notifications
Clear all

verificaçao

10 Posts
2 Usuários
0 Reactions
2,109 Visualizações
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

como ja sabem eu tenho uma planiha para fichas tecnicas ....
nas paginas tem 2 botoes ....
o de procurar e o de gravar ....
o de procurar faz-um "loop " acho que e assim que se diz ... que verifica se a refrencia que eu pedi para procurar existe , se ela nao existir ele me avisa ...
o precisava que o botao de gravar tambem me fize-se um loop para evitar gravar referencias repitidas ....

naos sei se me fiz entender ???
vou deixar aqui o codigo do dos botoes ....

Botao procurar

Private Sub CommandButton1_Click()
If txtRef.Text = "" Then
MsgBox "Digite uma referencia valida"
txtRef.SetFocus
GoTo Linha1
End If

With Worksheets("Fichas").Range("A:A")

Set c = .Find(txtRef.Value, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
txtRef.Value = c.Value
txtEpoca.Value = c.Offset(0, 1).Value
txtCliente.Value = c.Offset(0, 2).Value
txtProduçao.Value = c.Offset(0, 3).Value
txtForma.Value = c.Offset(0, 4).Value
txtSistema.Value = c.Offset(0, 5).Value
txtConstruçao.Value = c.Offset(0, 6).Value

'Chama a rotina para carregar a figura
Call CarregaFigura

Else
MsgBox "Referência Inexistente !"

End If

End With
Linha1:
End Sub

Botao gravar ...

eu precisava que este botao visse que se o que eu escrivi ja existe e me alerte ....~

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Fichas").Activate
'Selecionar a célula A3
Range("A3").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = txtRef.Value
ActiveCell.Offset(0, 1).Value = txtEpoca.Value
ActiveCell.Offset(0, 2).Value = txtCliente.Value
ActiveCell.Offset(0, 3).Value = txtProduçao.Value
ActiveCell.Offset(0, 4).Value = txtForma.Value
ActiveCell.Offset(0, 5).Value = txtSistema.Value
ActiveCell.Offset(0, 6).Value = txtConstruçao.Value

 
Postado : 16/11/2011 9:58 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Gonçalo, a tempos estava para postar uma dica sobre "Pesquisar", então aproveito sua solicitação e posto aqui uma Function que pode ser adaptada a qualquer situação, e evitando ter de repetirmos várias instruções nas rotinas, somente fazemos a chamada a Function :

Dim sCel
Dim sLocaliza As Boolean

Sub Pesquisar()
    
    'Valor a pesquisar
    RefId = 2
    
    'Chama a Function
    ProcuraRefId (RefId)
     
    If sLocaliza = True Then
        MsgBox "Referencia :- " & RefId & " Localizada em :- " & sCel
        'Coloque aqui a rotina par continuar
    Else
        MsgBox "Referencia não Localizada"
    End If
    
End Sub

Public Function ProcuraRefId(ByVal RefId As String) As String
    Dim iLin As Long
    Dim sCol As Long
    
    sLocaliza = False

    Dim wsDados As Worksheet
    Set wsDados = Worksheets("Dados")
    
    iLin = 2 'Linha 2
    sCol = 1 'Coluna 1
    
    With wsDados
    
        Do While Not IsEmpty(.Cells(iLin, sCol))

            If .Cells(iLin, sCol).Value = RefId Then
             
                sLocaliza = True 'Verdadeiro se encontrado
                sCel = .Cells(iLin, sCol).Address(False, False)
                
                Exit Do 'Sai do Loop se encontrar
            
            End If
            
            'Incrementa a linha
            iLin = iLin + 1
            
        Loop
        
    End With

End Function

Par o seu caso especifico, altere o nome da Worksheets, e na rotina que irá fazer a chamada a Function, defina

RefId = 2 para RefId = txtRef, se não me falha a memória é este Textbox que digita a referencia.

Faça os testes e qq duvida retorne.

** Em tempo : Postei um exemplo no Forum Dicas & Macetes:
viewtopic.php?f=28&t=2816

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/11/2011 1:05 pm
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

nao funfou , S mas obrigado pela tentativa ....
neste caso eu tentei na primeira que tambem tem a rotina da figura...

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Fichas").Activate
'Selecionar a célula A3
Range("A3").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = txtRef.Value
ActiveCell.Offset(0, 1).Value = txtEpoca.Value
ActiveCell.Offset(0, 2).Value = txtCliente.Value
ActiveCell.Offset(0, 3).Value = txtProduçao.Value
ActiveCell.Offset(0, 4).Value = txtForma.Value
ActiveCell.Offset(0, 5).Value = txtSistema.Value
ActiveCell.Offset(0, 6).Value = txtConstruçao.Value
ActiveCell.Offset(0, 7).Value = txtObs

End Sub

Private Sub CommandButton1_Click()
Dim sCel
Dim sLocaliza As Boolean

Sub Pesquisar()
   
    'Valor a pesquisar
    RefId = txtRef.Text

   
    'Chama a Function
    ProcuraRefId (RefId)
     
    If sLocaliza = True Then
        MsgBox "Referencia :- " & RefId & " Localizada em :- " & sCel
        
If txtRef.Text = "" Then
            MsgBox "Digite uma referencia valida"
            txtRef.SetFocus
        GoTo Linha1
    End If
    
    With Worksheets("Fichas").Range("A:A")
        
        Set c = .Find(txtRef.Value, LookIn:=xlValues, LookAt:=xlPart)
            If Not c Is Nothing Then
            txtRef.Value = c.Value
txtEpoca.Value = c.Offset(0, 1).Value
txtCliente.Value = c.Offset(0, 2).Value
txtProduçao.Value = c.Offset(0, 3).Value
txtForma.Value = c.Offset(0, 4).Value
txtSistema.Value = c.Offset(0, 5).Value
txtConstruçao.Value = c.Offset(0, 6).Value
txtObs.Value = c.Offset(0, 7).Value
            'Chama a rotina para carregar a figura
            Call CarregaFigura
            
        Else
            MsgBox "Referência Inexistente !"
            
        End If
        
    End With
Linha1:
End Sub

'Carregar a Figura associada
Private Sub CarregaFigura()
    
    'Local onde estão as Figuras
    PicPath = "f:PlanilhandoGoncaloImagens"
    
    'Atribui a Variavel o Caminho e Nome da Figura
    ffname = PicPath & txtRef & ".jpg"
    
    'Limpa a Imagem anterior
    Image_Produto.Picture = Nothing

    On Error Resume Next
        'Localiza a figura adiciona ao form e define a propriedade
        Image_Produto.Picture = LoadPicture(ffname)
        Image_Produto.PictureSizeMode = fmPictureSizeModeStretch 'fmPictureSizeModeZoom
    
        'Informa se não tiver figura associada
        If Err = "53" Then
            MsgBox "Não tem Figura associada !!! "
            Image_Produto.Picture = LoadPicture(PicPath & "no_image.jpg")
        End If
      
End Sub



Private Sub CommandButton11_Click()
  Dim Title As String
    Dim Filename As Variant

    If txtRef = "" Then
        MsgBox "Digite a referencia !!!", 64, "Produto"
        Exit Sub
    End If

    ' Titulo da Caixa de Dialogo
    Title = "Selecione a Figura"
    
    ' Seleciona o Drive & Path Inicial onde estão as figuras
    'Altere a Localização
    ChDrive ("F")
    'Define o Novo Diretório
    ChDir ("F:PlanilhandoGoncaloImagens")
    
    With Application
        
        ' Caixa de Dialogo para  Selecionar o arquivo
        'Ira abrir no Diretório atribuido acima em ChDrive e ChDir
        Filename = .GetOpenFilename("Picture(*.jpg;*.gif;*.bmp),*.*;", , Title, "False")
        
            ' Sair ou Cabncelar
            If Filename = False Then
                MsgBox "Nenhum Arquivo Selecionado !!!"
                
                ' Redefine o Drive/Path Padrão (C:MeusDocumentos)
                ChDrive (Left(.DefaultFilePath, 1))
                ChDir (.DefaultFilePath)
                
                Exit Sub
            End If
            
           'Coloca a Imagem no Form e define a propriedade
           Image_Produto.Picture = LoadPicture(Filename)
           Image_Produto.PictureSizeMode = fmPictureSizeModeStretch 'fmPictureSizeModeZoom
        
    End With
      Else
        MsgBox "Referencia não Localizada"
    End If
   
End Sub

postei o codo a ver se nao cometi nenhum erro ;S se puder da uma olhada ...

 
Postado : 16/11/2011 2:16 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Gonçalo, você misturou as rotinas, ou seja, eu postei um Function, onde a mesma é chamada pela rotina Pesquisar, ou seja é somente mais uma opção e as referencias às Variaveis :
Dim sCel
Dim sLocaliza As Boolean
Ficam fora da rotina, se baixou o exemplo que postei em Dicas e Macetes deve ter percebido isto.

Agora, mesmo que você separe tudo, você tem de definir o que irá fazer, veja bem em sua rotina original você já utiliza o FIND para localizar se uma referencia existe e se existir preenche os campos do formulário, se estiver acompanhando o raciocinio, verá que não tem como colocar na mesma rotina a opção de se ja existir a referencia a mesma não fazer nada, devemos ter botões separados, um para Lançar um novo Produto, onde faremos a verificação e outro Botão para Pesquisar e preencher os campos.

Se for adaptar a Rotina com chamada a Function a um commandButton, tem de ficar assim :

Private Sub CommandButton20_Click()
   
    'Valor a pesquisar
    RefId = txtRef.Text
   
    'Chama a Function
    ProcuraRefId (RefId)
     
    If sLocaliza = True Then
        MsgBox "Referencia :- " & RefId & " Já Exite Localizada em :- " & sCel
        'Coloque aqui a rotina para continuar
        'Ou seja sair da rotina sem fazer nada
        Exit Sub
    Else
        MsgBox "Referencia não Existe"
        'Coloque aqui a rotina para continuar
        'ou seja a chamada para a rotina que lança naplanilha
    End If
   
End Sub

ou no Evento Exit, AfterUpdate, do txtRef.

Espero ter sido claro, qualquer duvida retorne, lembrando que você pode realizar a verificação se existe com a criação de outra rotina utilizando o FIND.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/11/2011 7:40 pm
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

Mauro penso que agora entendi ;S

 RefId = txtRef.Text
   
    'Chama a Function
    ProcuraRefId (RefId)
     
    If sLocaliza = True Then
        MsgBox "Referencia :- " & RefId & " Já Exite Localizada em :- " & sCel
        MsgBox "Digite uma refêrencia valida"
        Exit Sub
    Else
        Call Gravar
        
        'Coloque aqui a rotina para continuar
        'ou seja a chamada para a rotina que lança naplanilha
    End If

funciona tudo muito bem , mas nao faz o efeito pretendendido ;S
eu acho que ai falta o sitio onde a rotina procurar ....
deve porcurar o valor digitado em txtRef
mas eu ano tou vendo o sitio para por ...
:S Desculpe a Ignorancia :?

 
Postado : 17/11/2011 4:43 am
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

VOLTEI A TENTAR ;( MAS NAO DA SSIM TB

Private Sub CommandButton7_Click()

RefId = txtRef.Text
   
    'Chama a Function
    ProcuraRefId (RefId)
     
    If sLocaliza = True Then
        MsgBox "Digite uma refêrencia valida"
        Exit Sub
    Else
        Call Gravar
        
        'Coloque aqui a rotina para continuar
        'ou seja a chamada para a rotina que lança naplanilha
    End If

End Sub

Sub Gravar()
If txtRef.Text = "" Then
MsgBox "Digite uma refêrencia valida"
txtRef.SetFocus

End If
'Ativar a primeira planilha
ThisWorkbook.Worksheets("Corte").Activate
'Selecionar a célula A3
Range("A3").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select


End If

Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = txtRef.Value
ActiveCell.Offset(0, 1).Value = txtProduçao.Value
ActiveCell.Offset(0, 2).Value = txtPelaria1.Value
ActiveCell.Offset(0, 3).Value = txtPelaria2.Value
ActiveCell.Offset(0, 4).Value = txtpelaria3.Value
ActiveCell.Offset(0, 5).Value = txtForros.Value
ActiveCell.Offset(0, 6).Value = txtWtd.Value
ActiveCell.Offset(0, 7).Value = txtPalmilha.Value
ActiveCell.Offset(0, 8).Value = txtFita.Value
ActiveCell.Offset(0, 9).Value = txtEspuma1.Value
ActiveCell.Offset(0, 10).Value = txtEspuma2.Value
ActiveCell.Offset(0, 11).Value = txtEspuma3.Value
ActiveCell.Offset(0, 12).Value = txtSinteticos.Value
ActiveCell.Offset(0, 13).Value = txtReforço.Value
ActiveCell.Offset(0, 14).Value = txtElasticos.Value
ActiveCell.Offset(0, 15).Value = txtObs.Value
End Sub
Public Function ProcuraRefId(ByVal RefId As String) As String
    Dim iLin As Long
    Dim sCol As Long
    
    sLocaliza = False

    Dim wsDados As Worksheet
    Set wsDados = Worksheets("Corte")
    
    iLin = 3 'Linha 2
    sCol = 1 'Coluna 1
    
    With wsDados
    
        Do While Not IsEmpty(.Cells(iLin, sCol))

            If .Cells(iLin, sCol).Value = RefId Then
             
                sLocaliza = True 'Verdadeiro se encontrado
                sCel = .Cells(iLin, sCol).Address(False, False)
                
                Exit Do 'Sai do Loop se encontrar
            
            End If
            
            
        Loop
        
    End With

End Function

MAURO VOCE ARRANJOU UM GAIJO CHATO PA C..... dESCULPE

 
Postado : 17/11/2011 5:00 am
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

AAAAAIIIIIIIIIIIIII carai ;D desculpem linguagem .... consigui descbrir mauro ... valeu .....
so tem mesmo um pequeno probleminha (Grande XD)
a uma parte do codigo que tem

Dim wsDados As Worksheet
    Set wsDados = Worksheets("Fichas")
    
    iLin = 4 'Linha 2
    sCol = 1 'Coluna 1

OU SEJA ELE ESTA A PESQUISAR A COLUNA 1 NA LINHA 4 ...
EU PRECISO QUE ELE PROCURE EM TODAS AS LINHAS E NAO SO NA LINHA 4 ;s

:)

PESSOAL PLANINHANDO I «3 YOU

 
Postado : 17/11/2011 11:18 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

gonçalo, oras pois, sem esta de "arrumei um gaijo", rsrsrsrsrsrsrsrrs

Voltando a sua questão, como não postou a rotina inteira que fez a adaptação, fico sem saber o que modificou, mas se no inicio tens :

iLin = 4 'Linha 4

Veja na Function, apos o End If antes do Loop temos o incremento para pegar a próxima Linha :
'Incrementa a linha, ou seja, iLin = 4 então :
iLin = iLin + 1
4 = 4 + 1 = proxima linha 5 e assim por diante

espero que tenha compreendido, qualquer duvida poste a rotina.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/11/2011 4:45 pm
(@goncalo)
Posts: 91
Trusted Member
Topic starter
 

isso ja esta na sub funçao mauro ,S vou postar aqui para voce ver o que eu adaptei ....

Private Sub cmdGravar_Click()
RefId = txtRef
   
   If RefId = "" = vbNullString Then
        MsgBox "Operação Cancelada ou Valor Inválido"
        Exit Sub

    Else
        'Chama a Function
        ProcuraRefId (RefId)
    End If
    
    If sLocaliza = True Then
        MsgBox "REFERENCIA REPETIDA"
    Else
    
'Ativar a primeira planilha
ThisWorkbook.Worksheets("Fichas").Activate
'Selecionar a célula A3
Range("A3").Select

'Procurar a primeira célula vazia
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = txtRef.Value
ActiveCell.Offset(0, 1).Value = txtEpoca.Value
ActiveCell.Offset(0, 2).Value = txtCliente.Value
ActiveCell.Offset(0, 3).Value = txtProduçao.Value
ActiveCell.Offset(0, 4).Value = txtForma.Value
ActiveCell.Offset(0, 5).Value = txtSistema.Value
ActiveCell.Offset(0, 6).Value = txtConstruçao.Value
ActiveCell.Offset(0, 7).Value = txtObs
End If

End Sub

aqui esta o comando do botao .....

Public Function ProcuraRefId(ByVal RefId As String) As String
    Dim iLin As Long
    Dim sCol As Long
    
    sLocaliza = False

    Dim wsDados As Worksheet
    Set wsDados = Worksheets("Fichas")
    
    iLin = 4 'Linha 2
    sCol = 1 'Coluna 1
    
    With wsDados
    
        Do While Not IsEmpty(.Cells(iLin, sCol))

            If .Cells(iLin, sCol).Value = RefId Then
             
                sLocaliza = True 'Verdadeiro se encontrado
                sCel = .Cells(iLin, sCol).Address(False, False)
                
                Exit Do 'Sai do Loop se encontrar
            
            End If
            
            'Incrementa a linha
            iLin = iLin + 1
            
        Loop
        
    End With

End Function

aqui a funçao -----
se puder da uma olhada. D

 
Postado : 17/11/2011 6:21 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

gonçalo, olhando assim parece tudo correto, o ideal seria ter o modelo para analizar.

Mesmo em sua adaptação a rotina só não prosseguirá se encontrar a referencia, ou se na coluna 1 não tiverem preenchidas.

anexe o novo modelo.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 17/11/2011 6:56 pm