Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
simplificar com loo...
 
Notifications
Clear all

simplificar com loop

 
Página 2 / 4
2024 - VBA & Macros
Post Recente por leandroxtr 8 anos atrás
50 Posts
4 Usuários
0 Reactions
5,288 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Boa Tarde

Teria como simplificar a macro abaixo pois vou tera mais linhas iguais.

Teria como colocar um loop ai ?

mudara: Pro1.Value , Label_Pro1, Label_Pro1A ....

Private Sub Pro1_Enter()

Sheets("Estoque").Activate

Dim intervalo As Range
Dim codigo As Integer
Set intervalo = Plan19.Range("B6:W605")
            
codigo = Pro1.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro1.Caption = Pesquisa
Label_Pro1A.Caption = Pesquisa1

codigo = Pro2.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro2.Caption = Pesquisa
Label_Pro2A.Caption = Pesquisa1

codigo = Pro3.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro3.Caption = Pesquisa
Label_Pro3A.Caption = Pesquisa1

codigo = Pro4.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro4.Caption = Pesquisa
Label_Pro4A.Caption = Pesquisa1

codigo = Pro5.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro5.Caption = Pesquisa
Label_Pro5A.Caption = Pesquisa1

codigo = Pro6.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro6.Caption = Pesquisa
Label_Pro6A.Caption = Pesquisa1

codigo = Pro7.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro7.Caption = Pesquisa
Label_Pro7A.Caption = Pesquisa1

codigo = Pro8.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro8.Caption = Pesquisa
Label_Pro8A.Caption = Pesquisa1

codigo = Pro8.Value
  Pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
  Pesquisa1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
Label_Pro8.Caption = Pesquisa
Label_Pro8A.Caption = Pesquisa1






End Sub
 
Postado : 27/01/2017 11:21 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Bernardo, na imagem ficou ainda puxando as duas ultimas imagens , somente se é pra puxar se tiver o codigo.

Tem a solucao ?

Grato

Andre

 
Postado : 27/01/2017 1:34 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

se nao for pedir muito vc adapta este aqui tb que esta ligado ao outro.

Essa abaixo é chamado por outro comando

Aqui tive que por +6 porque na planilha Estoque os produtos se iniciam na linha 7
Cod = Pro1.Value + 6

Private Sub CommandButton4_Click()

Me.MultiPage1.Value = 3

Dim Cod
Dim Caminho

'--------------------------------------------------------
If Pro1 <> "" Then
Cod = Pro1.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)
    
    Set Image319.Picture = LoadPicture(Caminho)
    Image319.PictureSizeMode = fmPictureSizeModeClip
 End If
'--------------------------------------------------------
If Pro2 <> "" Then
Cod = Pro2.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image328.Picture = LoadPicture(Caminho)
    Image328.PictureSizeMode = fmPictureSizeModeClip
 End If
'--------------------------------------------------------
If Pro3 <> "" Then
Cod = Pro3.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image366.Picture = LoadPicture(Caminho)
    Image366.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------

If Pro4 <> "" Then
Cod = Pro4.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image369.Picture = LoadPicture(Caminho)
    Image369.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------
If Pro5 <> "" Then
Cod = Pro5.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image368.Picture = LoadPicture(Caminho)
    Image368.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------
If Pro6 <> "" Then
Cod = Pro6.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image367.Picture = LoadPicture(Caminho)
    Image367.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------

If Pro7 <> "" Then
Cod = Pro7.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image376.Picture = LoadPicture(Caminho)
    Image376.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------

If Pro8 <> "" Then
Cod = Pro8.Value + 6
Caminho = Sheets("Estoque").Range("AO" & Cod)

    Set Image374.Picture = LoadPicture(Caminho)
    Image374.PictureSizeMode = fmPictureSizeModeClip
End If
'--------------------------------------------------------

End Sub
 
Postado : 27/01/2017 1:47 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Aqui redefini

Set Image319.Picture = LoadPicture(Caminho)
Image319.PictureSizeMode = fmPictureSizeModeClip

para

Set Imagem1.Picture = LoadPicture(Caminho)
Imagem1.PictureSizeMode = fmPictureSizeModeClip

e assim vai nas outras

fiz assim pra efeito de teste mas so carrega a 1 imagem

  Dim i           As Long
  Dim x As Integer
  Dim y As Integer
 
  
  
  For i = 1 To 3 '00 'vai do 1 ao 200
  
   x = 7
   y = 1

If "Pro" & i <> "" Then


'        Cod = Me.Controls("Pro" & i).Value
        Caminho = Sheets("Estoque").Range("AO" & x)
        
        
    Set Me.Controls("Imagem" & y).Picture = LoadPicture(Caminho)
    Me.Controls("Imagem" & y).PictureSizeMode = fmPictureSizeModeClip
        
        End If
        
    Next i

End Sub
 
Postado : 27/01/2017 3:35 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Cheguei a isso,

mas esta puxando a imagem numero 1 da planilha e nao o codigo que esta em "Pro"

eu ja entendi que é devido a isso : Range("AO" & i + 6), mas como vou colocar puxando pela Pro1, Pro2, Pro3 ....

Private Sub CommandButton4_Click()

Me.MultiPage1.Value = 3

Dim Cod
Dim Caminho
'--------------------------------------------------------

  Dim i           As Long
  
  For i = 1 To 3 '00 'vai do 1 ao 200

If "Pro" & i <> "" Then

        Caminho = Sheets("Estoque").Range("AO" & i + 6)
        
    Set Me.Controls("Imagem" & i).Picture = LoadPicture(Caminho)
    Me.Controls("Imagem" & i).PictureSizeMode = fmPictureSizeModeClip
        
        End If
        
    Next i

End Sub
 
Postado : 27/01/2017 4:15 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ou seja

For i = 1 To 3 '00 'vai do 1 ao 200 , aqui teria como adaptar for i = imagem1 to imagem 100 ???

If "Pro" & i <> "" Then

Caminho = Sheets("Estoque").Range("AO" & i + 6) entao se acima for possivel esta linha ficaria :
' Caminho = Sheets("Estoque").Range("AO" & i)

Set Me.Controls("Imagem" & i).Picture = LoadPicture(Caminho)
Me.Controls("Imagem" & i).PictureSizeMode = fmPictureSizeModeClip

 
Postado : 27/01/2017 5:53 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

quebrei a cabeça pacas, esta bagunçado eu sei, mas nao é que funcionou !!

Se alguem puder simplificar ou fazer de outra forma para que funcione, eu agradeço.

Andre

Private Sub CommandButton4_Click()

Me.MultiPage1.Value = 3

Dim Cod
Dim Caminho
'--------------------------------------------------------

  Dim i           As Long
  Dim x As Integer
  Dim w
  Dim w2
  Dim w3
  w3 = 1
  Dim w4
  
 'Sheets(D).D
 
  
  For i = 1 To 2 '00 'vai do 1 ao 200

If "Pro" & i <> "" Then

x = Me.Controls("Pro" & i).Value

Plan19.Range("A2").Value = x
w = x + Plan19.Range("A2").Value
Plan19.Range("B2").Value = w + 5
w2 = Plan19.Range("B2").Value
w4 = w3 + Plan19.Range("B3").Value

        Caminho = Sheets("Estoque").Range("AO" & w2) ' i + 6)
        
    Set Me.Controls("Imagem" & w4).Picture = LoadPicture(Caminho)
    Me.Controls("Imagem" & w4).PictureSizeMode = fmPictureSizeModeClip
        
           Plan19.Range("B3").Value = 1
        
        End If
        
    Next i

 Plan19.Range("B3").Value = 0

End Sub
 
Postado : 28/01/2017 3:35 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Estava errado, segue o correto, agora funcionou mais tive que associar algumas celulas da planilha + Variaveis , bem funcionou beleza.

Ai Bernardo, se puder simplificar essa bagunça bz. Se nao der vai assim mesmo, quem nao tem cao caça com gato mesmo, negocio é levar a comida pra casa.

Andre

Private Sub CommandButton4_Click()

Me.MultiPage1.Value = 3

Dim Cod
Dim Caminho
'--------------------------------------------------------

  Dim i           As Long
  Dim x As Integer
  Dim w
  Dim w2
  Dim w3
  w3 = 1
  Dim w4
  
 'Sheets(D).D
 
  
  For i = 1 To 3 '100 'vai do 1 ao 200

If "Pro" & i <> "" Then

x = Me.Controls("Pro" & i).Value

Plan19.Range("A2").Value = x
w = x + Plan19.Range("A2").Value
'Plan19.Range("B2").Value = w + 5
Plan19.Range("B2").Value = Me.Controls("Pro" & i).Value


w2 = Plan19.Range("A3").Value
w4 = 1 + Plan19.Range("B3").Value  'w3 + Plan19.Range("B3").Value

        Caminho = Sheets("Estoque").Range("AO" & w2) ' i + 6)
        
    Set Me.Controls("Imagem" & w4).Picture = LoadPicture(Caminho)
    Me.Controls("Imagem" & w4).PictureSizeMode = fmPictureSizeModeClip
        
           Plan19.Range("B3").Value = Plan19.Range("B3").Value + 1
        
        End If
         Plan19.Range("B2").Value = ""
        
    Next i

 Plan19.Range("B3").Value = 0
Plan19.Range("A2").Value = ""

End Sub
 
Postado : 28/01/2017 4:36 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Tem sim, tente desta forma:

Amigao, usei a sugestão do Bernardo, mas sua dica me abriu tb a mente para resolver uma outra parte do formulario que estava associado a este.

Te agradeço muito mesmo , com a sua ajuda e a do Brenardo, resolvi esta parte do Formulario . Agradeço a vc e ao Bernardo, e claro a todos do Forum que me ajudaram em outras tantas ocasioes. O bom disso tudo que estou aprendendo cada vez mais a linguagem VBA. Antes de postar aqui alguma ajuda é porque ja bati muito a cabeça. Como agora neste codigo.

Grato.

Assim ficou o resumido que consegui alcançar.

Ta tudo ok agora, se tiver mais duvidas em outras partes sei que aqui é o lugar de resolver as paradas !!

Andre

Private Sub CommandButton4_Click()

Me.MultiPage1.Value = 3

  Dim Caminho
  Dim i           As Long
  Dim x As Integer
  Dim w
  Dim w2
  Dim w3
  Dim Aux1
  Dim Aux2
  Dim Aux3
  Dim Aux4
  Aux4 = 0
  
  For i = 1 To 6 'vai do 1 ao 200

      If "Pro" & i <> "" Then

          x = Me.Controls("Pro" & i).Value
          Aux1 = Me.Controls("Pro" & i).Value
          Aux2 = Aux1 + 6
          w3 = 1 + Aux4

Caminho = Sheets("Estoque").Range("AO" & Aux2)
        
   Set Me.Controls("Imagem" & w3).Picture = LoadPicture(Caminho)
   Me.Controls("Imagem" & w3).PictureSizeMode = fmPictureSizeModeClip
        
          Aux4 = Aux4 + 1
        
  End If
            
         Next i

End Sub
 
Postado : 28/01/2017 5:38 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

nessa expressao teria como nao colocar o 100 e ficar a cargo do ultimo na planilha ?

For i = 1 To 100 'vai do 1 ao 100

tipo assim :

For i = 1 To ...

 
Postado : 28/01/2017 6:19 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia fazerbem,

Cara, achei meio confuso esse último código...
Dando muita volta.
Fora que não sei se o código que enviou está completo, se tem alguma variável pública por exemplo....

Essa última, está declarando a variável "w" e "w2", por exemplo, e ela não aparece no código...
Mas é porque vi que removeu a linha que ela estava sendo atribuída, pois estava atribuindo ao valor para a variável "w" para nada...
Aí esqueceu de remover a declaração da variável..

Mas essas duas linhas:
x = Me.Controls("Pro" & i).Value
Aux1 = Me.Controls("Pro" & i).Value

É o mesmo valor para as duas variávels...
Entretanto, uma é utilizada e outra não.

Estou modificando o código as cegas...
Tenho medo de acrescentar ou remover algo e dar erro por exemplo... Não consigo fazer testes...

Como disse... Não fiz testes, mas tenta assim:

Option Explicit

Private Sub CommandButton4_Click()
Dim i       As Long
Dim Aux1    As String
Dim Aux2    As String
Dim Caminho As String

    Me.MultiPage1.Value = 3
    Aux2 = 1
    i = 1

    Do: If Atribuir(i) = False Then Exit Sub
        Aux1 = Me.Controls("Pro" & i).Value
        Plan19.Range("A2").Value = Aux1

        Caminho = Sheets("Estoque").Range("AO" & Aux1 + 6)
           
        Set Me.Controls("Imagem" & Aux2).Picture = LoadPicture(Caminho)
        Me.Controls("Imagem" & Aux2).PictureSizeMode = fmPictureSizeModeClip
           
        Aux2 = Aux2 + 1
        i = i + 1
    Loop

End Sub

Private Function Atribuir(ByVal i As String) As Boolean
On Error GoTo NaoExiste
    
    If Me.Controls("Pro" & i).Value = Empty Then Atribuir = True
    Exit Function
NaoExiste:
    Atribuir = False
End Function

Qualquer coisa da o grito.
Abraço

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

 
Postado : 30/01/2017 6:14 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Bernardo segue anexo a planilha, mas tera que habilitar algumas referencias do VBA se nao o formulario Caixa1 nao vai rodar.

Clique Menu Proteinas
depois basta clicar nas imagens , mas antes tera que criar o caminho que esta na Plan Estoque colunas AO

Andre

 
Postado : 30/01/2017 10:23 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cara, não tem como, pois não possuo os caminhos muito menos as imagens...
Criei um módulo que chama apenas um formulário e adapta o tamanho de acordo com a mensagem que deseja...
Você vai acabar se perdendo com tanto formulário de avisos...

Diminuí um pouco a rotina de "coloração" dos botões entre amarelo e verde...
Dá pra encurtar e deixar mais dinâmico muita coisa aí...

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

 
Postado : 30/01/2017 12:01 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Criei um módulo que chama apenas um formulário e adapta o tamanho de acordo com a mensagem que deseja...
.

nao entendi este formulario, como ele funciona ?

De fato gosto de colocar cores, isso pode prejudicar a velocidade ? Se sim me explica onde devo tirar.

Teve alguma outra modificacao nos codigos ?

Quanto as imagens nao mandei porque ia ficar pesado demais pra mandar por aqui mesmo zipado.

Outra coisa, vou criar agora os caixas 2, 3, 4 e 5, e serao identicos ao caixa 1.Porem quero que os formularios
XPagamento2, Troco , empresa1 e sabores... sejam universais e podendo ser chamadas independentemente de qual caixa esteja, pois serao temporarios.

Para que isso possa acontecer preciso criar variaveis tipo :

Caixa1.XPagamento.TextBox1.value = .....

para

Dim Ativo As String
Ativo=XPagamento.TextBox1.Value

Assim Ativo poderia ser usado para chamar qualquer caixa, e assim usar mais de um caixa quando tiver mais de 1 cliente no atendimento. Tipo comander usado em restaurante. Usarei os Caixas 1, 2, 3, 4 e 5 como SHOWMODAL = FALSE

Andre

 
Postado : 30/01/2017 12:34 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Quanto ao formulário das mensagens...
Você tem um formulário para cada tipo de mensagem.

Basta definir o texto a uma variável e chamar um único formulário para mensagens...
Segue ela em uma planilha separadamente.

As cores não são o problema... Mas se for alterar a cor por exemplo, vai ter que mexer muita coisa manualmente...
Eu defini as cores em uma variável e atribuí aos controles a essa variável...
Se mudar de ideia quanto a cor, basta alterar a variável...
E outra...
Invés de colorir tudo individualmente e colorir uma em separado, criei uma sub para tipo "restaurar" a cor.

No lugar disso:

Private Sub CommandButton10_Click()

Me.CommandButton10.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 8 ' pula para a pág 1
End Sub

Private Sub CommandButton11_Click()

Me.CommandButton11.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 10 ' pula para a pág 1
End Sub

Private Sub CommandButton12_Click()

Me.CommandButton12.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 1 ' pula para a pág 1

End Sub

Private Sub CommandButton4_Click()

Me.CommandButton4.BackColor = &H80FF80  'Verde
Me.CommandButton12.BackColor = &H80FFFF    'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Categoria.Value = "P"


Me.MultiPage1.Value = 3

  Dim Caminho
  Dim i           As Long
  Dim x As Integer
  Dim w
  Dim w2
  Dim w3
  Dim Aux1
  Dim Aux2
  Dim Aux3
  Dim Aux4
  Aux4 = 0
  
  For i = 1 To 18 'vai do 1 ao 100

      If "Pro" & i <> "" Then

          x = Me.Controls("Pro" & i).Value
          Aux1 = Me.Controls("Pro" & i).Value
          Aux2 = Aux1 + 6
          w3 = 1 + Aux4

Caminho = Sheets("Estoque").Range("AO" & Aux2)
        
   Set Me.Controls("Imagem" & w3).Picture = LoadPicture(Caminho)
   Me.Controls("Imagem" & w3).PictureSizeMode = fmPictureSizeModeClip
        
          Aux4 = Aux4 + 1
        
  End If
            
         Next i

'---------------------------------------------------------------
Dim t As Byte
Dim j As Byte
t = 0
For j = 1 To 54
If Len(Me("Pro" & j) & "") > 0 Then t = t + 1
Next
If t = 1 Then
MsgBox "Existe " & t & " campo preenchido neste formulário."
ElseIf t = 0 Then
'MsgBox "Nenhum campo preenchido neste formulário."
Else
Total_Imagens.Value = t

'MsgBox "Existem " & t & " campos preenchidos neste formulário."
End If

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

End Sub

Private Sub CommandButton5_Click()

Me.CommandButton5.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 4

End Sub

Private Sub CommandButton51_Click()
Menu1.Show

End Sub

Private Sub CommandButton52_Click()
Livro_Caixa.Show

End Sub

Private Sub CommandButton55_Click()

If Total = "" Then
Mensagem3.Show
Exit Sub
End If
TextBox_Codigo = 2
TextBox_Nome = "Diversos"
Caixa1.PAGAMENTO.BackColor = &HFF&
Caixa1.PAGAMENTO.ForeColor = &HFFFFFF

End Sub

Private Sub CommandButton56_Click()

Me.CommandButton56.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 6 ' pula para a pág 1
End Sub

Private Sub CommandButton6_Click()

Me.CommandButton6.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 5 ' pula para a pág 1
End Sub

Private Sub CommandButton7_Click()

Me.CommandButton7.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 2 ' pula para a pág 1
End Sub

Private Sub CommandButton8_Click()

Me.CommandButton8.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton9.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 9 ' pula para a pág 1
End Sub

Private Sub CommandButton9_Click()

Me.CommandButton9.BackColor = &H80FF80   'Verde
Me.CommandButton4.BackColor = &H80FFFF   'Amarelo
Me.CommandButton7.BackColor = &H80FFFF   'Amarelo
Me.CommandButton5.BackColor = &H80FFFF   'Amarelo
Me.CommandButton6.BackColor = &H80FFFF   'Amarelo
Me.CommandButton56.BackColor = &H80FFFF   'Amarelo
Me.CommandButton12.BackColor = &H80FFFF   'Amarelo
Me.CommandButton10.BackColor = &H80FFFF   'Amarelo
Me.CommandButton8.BackColor = &H80FFFF   'Amarelo
Me.CommandButton11.BackColor = &H80FFFF   'Amarelo

Me.MultiPage1.Value = 7 ' pula para a pág 1
End Sub

Virou isso:

Private Sub TudoAmarelo()
    Me.CommandButton10.BackColor = CorAmarela
    Me.CommandButton4.BackColor = CorAmarela
    Me.CommandButton7.BackColor = CorAmarela
    Me.CommandButton5.BackColor = CorAmarela
    Me.CommandButton6.BackColor = CorAmarela
    Me.CommandButton56.BackColor = CorAmarela
    Me.CommandButton9.BackColor = CorAmarela
    Me.CommandButton12.BackColor = CorAmarela
    Me.CommandButton8.BackColor = CorAmarela
    Me.CommandButton11.BackColor = CorAmarela
End Sub

Private Sub CommandButton10_Click()
    Call TudoAmarelo
    Me.CommandButton10.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 8 ' pula para a pág 1
End Sub

Private Sub CommandButton11_Click()
    Call TudoAmarelo
    Me.CommandButton11.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 10 ' pula para a pág 1
End Sub

Private Sub CommandButton12_Click()
    Call TudoAmarelo
    Me.CommandButton12.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 1 ' pula para a pág 1
End Sub

Private Sub CommandButton4_Click()
    Call TudoAmarelo
    Me.CommandButton4.BackColor = &H80FF80  'Verde

Categoria.Value = "P"


Me.MultiPage1.Value = 3

  Dim Caminho
  Dim i           As Long
  Dim x As Integer
  Dim w
  Dim w2
  Dim w3
  Dim Aux1
  Dim Aux2
  Dim Aux3
  Dim Aux4
  Aux4 = 0
  
  For i = 1 To 18 'vai do 1 ao 100

      If "Pro" & i <> "" Then

          x = Me.Controls("Pro" & i).Value
          Aux1 = Me.Controls("Pro" & i).Value
          Aux2 = Aux1 + 6
          w3 = 1 + Aux4

Caminho = Sheets("Estoque").Range("AO" & Aux2)
        
   Set Me.Controls("Imagem" & w3).Picture = LoadPicture(Caminho)
   Me.Controls("Imagem" & w3).PictureSizeMode = fmPictureSizeModeClip
        
          Aux4 = Aux4 + 1
        
  End If
            
         Next i

'---------------------------------------------------------------
Dim t As Byte
Dim j As Byte
t = 0
For j = 1 To 54
If Len(Me("Pro" & j) & "") > 0 Then t = t + 1
Next
If t = 1 Then
MsgBox "Existe " & t & " campo preenchido neste formulário."
ElseIf t = 0 Then
'MsgBox "Nenhum campo preenchido neste formulário."
Else
Total_Imagens.Value = t

'MsgBox "Existem " & t & " campos preenchidos neste formulário."
End If

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

End Sub

Private Sub CommandButton5_Click()
    Call TudoAmarelo
    Me.CommandButton5.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 4
End Sub

Private Sub CommandButton51_Click()
Menu1.Show

End Sub

Private Sub CommandButton52_Click()
Livro_Caixa.Show

End Sub

Private Sub CommandButton55_Click()

If Total = "" Then
Mensagem3.Show
Exit Sub
End If
TextBox_Codigo = 2
TextBox_Nome = "Diversos"
Caixa1.PAGAMENTO.BackColor = &HFF&
Caixa1.PAGAMENTO.ForeColor = &HFFFFFF

End Sub

Private Sub CommandButton56_Click()
    Call TudoAmarelo
    Me.CommandButton56.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 6 ' pula para a pág 1
End Sub

Private Sub CommandButton6_Click()
    Call TudoAmarelo
    Me.CommandButton6.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 5 ' pula para a pág 1
End Sub

Private Sub CommandButton7_Click()
    Call TudoAmarelo
    Me.CommandButton7.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 2 ' pula para a pág 1
End Sub

Private Sub CommandButton8_Click()
    Call TudoAmarelo
    Me.CommandButton8.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 9 ' pula para a pág 1
End Sub

Private Sub CommandButton9_Click()
    Call TudoAmarelo
    Me.CommandButton9.BackColor = CorVerde   'Verde
    Me.MultiPage1.Value = 7 ' pula para a pág 1
End Sub

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

 
Postado : 30/01/2017 12:48 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

bernardo , tenha paciencia comigo, mas continuei sem entender o quesito mensagem.

eu tenho 5 ou 6 mensagens, cada uma associada a algum procedimento do formualrio Caixa1, como fazer aparecer um ou outra ? nao entendi mesmo, vi que escrevo a mensagem no modulo, terei que escrever varias mensagens ? explique melhor.

 
Postado : 30/01/2017 1:30 pm
Página 2 / 4
Forum Jump:
  Tópico Anterior
Próximo Tópico