none
[Projeto#1] VBA, PesquisaListBox, GerarArquivoemDoc RRS feed

  • Pergunta

  • Postando no Fórum para Consultar o Código depois

    # NÃO É UMA DÚVIDA # Só estou "guardando" o código aqui:

    DENTRO DOS USERFORMS DE PESQUISA:
    Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Pesquisa
    pesquisanome
    End Sub
    __________________________________________________________________________________________
    Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Pesquisa
    pesquisacodigo
    End Sub
    __________________________________________________________________________________________
    Private Sub UserForm_Initialize()
    'Pesquisa
    pesquisanome
    End Sub
    __________________________________________________________________________________________
    Private Sub ListBox1_Click()
    'Preenche os campos correspondentes na planilha, quando selecionado o item na ListBox:
    Dim ProdX, NomeX, TipoX, SUSEPX As Variant
    x = ListBox1.ListIndex
    ProdX = Me.ListBox1.List(x, 0)
    NomeX = Me.ListBox1.List(x, 1)
    TipoX = Me.ListBox1.List(x, 2)
    
    ThisWorkbook.Sheets("plan1").Activate
    Cells(6, 6) = ProdX
    Cells(8, 6) = NomeX
    Cells(9, 6) = TipoX
    Range("F2").FormulaLocal = "=procv(F6;plan2!A2:D23;4;0)"
    Cells(10, 6) = Range("F2").Value
    Range("F2").Value = ""
    
    AlertaTipo
    
    Unload UserForm1
    End Sub
    __________________________________________________________________________________________
    Sub AlertaTipo()
    'Alerta sobre PGBL X PGBL e VGBL X VGBL
    Dim ORIGEM, DESTINO As String
    ORIGEM = Cells(9, 6).Value
    DESTINO = Cells(9, 9).Value
    
    If ORIGEM = "" Then
        Exit Sub
    End If
    
    If DESTINO = "" Then
        Exit Sub
    End If
    
    If ORIGEM <> DESTINO Then
        MsgBox ("Atenção! O produto destino deve ser do mesmo tipo do produto origem (PGBL/VGBL)")
        Unload UserForm1
        UserForm1.Show
        Else
        Exit Sub
        End If
        
    End Sub
    __________________________________________________________________________________________
    DENTRO DO USERFORM DE VER LISTAGEM:
    Private Sub ListBox1_Enter()
    'Exibir a Fila de Termos para serem gerados
    Dim PS As Worksheet
    Dim linha, Range As Variant
    
    Set PS = ThisWorkbook.Worksheets("plan3")
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    
    Range = "plan3!" & "A1:" & "E" & UltimaLinha
    
    ListBox1.RowSource = Range
    
    'Exibir a quantidade de registros:
    For x = 1 To ListBox1.ListCount - 1
    If ListBox1.List(x, 0) <> "" Then
    m = m + 1
    End If
    Next
    TextBox1.Value = m
    
    End Sub
    __________________________________________________________________________________________
    Private Sub CommandButton2_Click()
    'Botão de Gerar Termos: Chama a Macro de Geração de Termos em Word
    
    GERADOC
    
    End Sub
    __________________________________________________________________________________________
    Private Sub CommandButton3_Click()
    'Botão de Limpar Lista: Chama a Macro que apaga os dados na Planilha plan3 = Armazenamento dos Dados
    
    ApagaLista
    
    End Sub
    __________________________________________________________________________________________
    Sub ApagaLista()
    'Apaga os dados na Planilha plan3 = Armazenamento dos Dados
    
    ThisWorkbook.Sheets("plan3").Activate
    
    Dim PS As Worksheet
    Dim linha, DeletaRange As Variant
    
    Set PS = ThisWorkbook.Worksheets("plan3")
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    UltimaLinha = UltimaLinha + 2
     
    DeletaRange = "A2:" & "R" & UltimaLinha
    
    Range(DeletaRange).Select
    Range(DeletaRange).Delete
    
    'Exibir a quantidade de registros:
    For x = 1 To ListBox1.ListCount - 1
    If ListBox1.List(x, 0) <> "" Then
    m = m + 1
    End If
    Next
    TextBox1.Value = m
    
    ThisWorkbook.Sheets("plan1").Activate
    
    End Sub
    __________________________________________________________________________________________
    MÓDULO 1
    ‘Macros de Pesquisa por Código e por Nome
    
    Private TextoDigitado As String
    
    Sub pesquisanome()
    
    TextoDigitado = UserForm1.TextBox1.Text
    'Range("a1").Select
     
     Dim Ws As Worksheet
     Dim linha As Integer
     Dim linhalistbox As Integer
     Dim TextoCelula As String
     
     Set Ws = ThisWorkbook.Worksheets("plan2")
     linha = 2
     linhalistbox = 0
     UserForm1.ListBox1.Clear
     
     With Ws
     
     While .Cells(linha, 1).Value <> Empty
     TextoCelula = .Cells(linha, 1).Value
     If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
     With UserForm1.ListBox1
     .AddItem
     .List(linhalistbox, 0) = Sheets("plan2").Cells(linha, 1)
     .List(linhalistbox, 1) = Sheets("plan2").Cells(linha, 2)
     .List(linhalistbox, 2) = Sheets("plan2").Cells(linha, 3)
    
     linhalistbox = linhalistbox + 1
     End With
     
     End If
     linha = linha + 1
     
     Wend
     
     End With
    
    End Sub
    
    __________________________________________________________________________________________
    
    Sub pesquisacodigo()
    
    TextoDigitado = UserForm1.TextBox2.Text
    'Range("a1").Select
     
     Dim Ws As Worksheet
     Dim linha As Integer
     Dim linhalistbox As Integer
     Dim TextoCelula As String
     
     Set Ws = ThisWorkbook.Worksheets("plan2")
     linha = 2
     linhalistbox = 0
     UserForm1.ListBox1.Clear
     
     With Ws
     
     While .Cells(linha, 1).Value <> Empty
     TextoCelula = .Cells(linha, 2).Value
     If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
     With UserForm1.ListBox1
     .AddItem
     .List(linhalistbox, 0) = Sheets("plan2").Cells(linha, 1)
     .List(linhalistbox, 1) = Sheets("plan2").Cells(linha, 2)
     .List(linhalistbox, 2) = Sheets("plan2").Cells(linha, 3)
    
     linhalistbox = linhalistbox + 1
     End With
     
     End If
     linha = linha + 1
     
     Wend
     
     End With
    
    End Sub
    
    __________________________________________________________________________________________
    MÓDULO 2
    ‘Exibir as Userforms – Atribuir aos Botões
    
    Sub Abre()
    
    UserForm1.Show ‘Pesquisa
    
    End Sub
    
    __________________________________________________________________________________________
    
    Sub Abre2()
    
    UserForm2.Show ‘Lista
    
    End Sub
    __________________________________________________________________________________________
    MODULO 3
    
    Sub Botão9_Clique()
    'Armazena os Dados Gravados na Planilha Auxiliar. O Botão de GRAVAR chama essa Macro
    
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("plan1").Activate
    
    'Verifica se há pelo menos 1 tipo de termo selecionado
    
    If Cells(5, 12).Value = "NÃO" Then
        PlanoQualificado = 0
        Else
        PlanoQualificado = 1
        End If
        
    If Cells(5, 13).Value = "NÃO" Then
        TermodeOpcao = 0
        Else
        TermodeOpcao = 1
        End If
        
    If Cells(5, 14).Value = "NÃO" Then
        PropostadeContratacao = 0
        Else
        PropostadeContratacao = 1
        End If
    
    If (PlanoQualificado + TermodeOpcao + PropostadeContratacao) = 0 Then
        MsgBox ("Atenção! Selecionar pelo menos 1 tipo de documento a ser gerado")
        Exit Sub
         End If
         
    'Armazendo as informações:
        'A - Opção Plano Qualificado:
         If PlanoQualificado = 1 Then
    Termo = "Plano Qualificado"
    Nome = Sheets("plan1").Range("C6")
    CPF = Sheets("plan1").Range("C7")
    NomeMenor = Sheets("plan1").Range("C12")
    Responsavel = Sheets("plan1").Range("C13")
    ProdutoOrigem = Sheets("plan1").Range("F6")
    PlanoOrigem = Sheets("plan1").Range("F7")
    NomeProdutoOrigem = Sheets("plan1").Range("F8")
    TipoOrigem = Sheets("plan1").Range("F9")
    SUSEPORIGEM = Sheets("plan1").Range("F10")
    ProdutoDestino = Sheets("plan1").Range("I6")
    PlanoDestino = Sheets("plan1").Range("I7")
    NomeProdutoDestino = Sheets("plan1").Range("I8")
    TipoDestino = Sheets("plan1").Range("I9")
    SUSEPDestino = Sheets("plan1").Range("I10")
    
    Dim linha As Variant
    Dim PS As Worksheet
    Set PS = ThisWorkbook.Worksheets("plan3")
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    
    linha = UltimaLinha + 1
    
    ThisWorkbook.Sheets("plan3").Activate
    Cells(linha, 1).Value = Termo
    Cells(linha, 2).Value = Nome
    Cells(linha, 3).Value = NomeMenor
    Cells(linha, 4).Value = ProdutoOrigem
    Cells(linha, 5).Value = ProdutoDestino
    Cells(linha, 6).Value = CPF
    Cells(linha, 7).Value = "" 'sexo
    Cells(linha, 8).Value = Responsavel
    Cells(linha, 9).Value = PlanoOrigem
    
    'Data
    Cells(linha, 17).Value = Date & "-" & Time
    'Usuário
    Cells(linha, 18).Value = UsuarioRede
        End If
        
        'B - Opção Plano Qualificado:
        If TermodeOpcao = 1 Then
    Termo = "Termo de Opção"
    Nome = Sheets("plan1").Range("C6")
    CPF = Sheets("plan1").Range("C7")
    NomeMenor = Sheets("plan1").Range("C12")
    Responsável = Sheets("plan1").Range("C13")
    ProdutoOrigem = Sheets("plan1").Range("F6")
    PlanoOrigem = Sheets("plan1").Range("F7")
    NomeProdutoOrigem = Sheets("plan1").Range("F8")
    TipoOrigem = Sheets("plan1").Range("F9")
    SUSEPORIGEM = Sheets("plan1").Range("F10")
    ProdutoDestino = Sheets("plan1").Range("I6")
    PlanoDestino = Sheets("plan1").Range("I7")
    NomeProdutoDestino = Sheets("plan1").Range("I8")
    TipoDestino = Sheets("plan1").Range("I9")
    SUSEPDestino = Sheets("plan1").Range("I10")
    
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    linha = UltimaLinha + 1
    
    ThisWorkbook.Sheets("plan3").Activate
    Cells(linha, 1).Value = Termo
    Cells(linha, 2).Value = Nome
    Cells(linha, 3).Value = NomeMenor
    Cells(linha, 4).Value = ProdutoOrigem
    Cells(linha, 5).Value = ProdutoDestino
    Cells(linha, 6).Value = CPF
    Cells(linha, 7).Value = "" 'sexo
    Cells(linha, 8).Value = Responsavel
    Cells(linha, 9).Value = PlanoOrigem
    
    'Data
    Cells(linha, 17).Value = Date & "-" & Time
    'Usuário
    Cells(linha, 18).Value = UsuarioRede
    
    End If
    
       'C - Opção Proposta de Contratação:
       If PropostadeContratacao = 1 Then
    Termo = "Proposta de Contratação"
    Nome = Sheets("plan1").Range("C6")
    CPF = Sheets("plan1").Range("C7")
    NomeMenor = Sheets("plan1").Range("C12")
    Responsável = Sheets("plan1").Range("C13")
    ProdutoOrigem = Sheets("plan1").Range("F6")
    PlanoOrigem = Sheets("plan1").Range("F7")
    NomeProdutoOrigem = Sheets("plan1").Range("F8")
    TipoOrigem = Sheets("plan1").Range("F9")
    SUSEPORIGEM = Sheets("plan1").Range("F10")
    ProdutoDestino = Sheets("plan1").Range("I6")
    PlanoDestino = Sheets("plan1").Range("I7")
    NomeProdutoDestino = Sheets("plan1").Range("I8")
    TipoDestino = Sheets("plan1").Range("I9")
    SUSEPDestino = Sheets("plan1").Range("I10")
         End If
         
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    linha = UltimaLinha + 1
         
    ThisWorkbook.Sheets("plan3").Activate
    Cells(linha, 1).Value = Termo
    Cells(linha, 2).Value = Nome
    Cells(linha, 3).Value = NomeMenor
    Cells(linha, 4).Value = ProdutoOrigem
    Cells(linha, 5).Value = ProdutoDestino
    Cells(linha, 6).Value = CPF
    Cells(linha, 7).Value = "" 'sexo
    Cells(linha, 8).Value = Responsavel
    Cells(linha, 9).Value = PlanoOrigem
    
    'Data
    Cells(linha, 17).Value = Date & "-" & Time
    'Usuário
    Cells(linha, 18).Value = UsuarioRede
         
    ThisWorkbook.Sheets("plan1").Activate
    Application.ScreenUpdating = True
    MsgBox ("Informações Armazenadas com Sucesso")
    
    End Sub
    __________________________________________________________________________________________
    
    Sub LimpaPainel()
    'O Botão LIMPAR DADOS chama essa Macro
    
        Range("D15,C6,C7,C12,C13,F6,F7,F8,F9,F10,I6,I8,I7,I9,I10").Select
        Range("I10").Activate
        Selection.ClearContents
        Range("A1").Select
        
    End Sub
    
    __________________________________________________________________________________________
    
    Function UsuarioRede() As String
    'Função Auxiliar para Captar o Usuário da Máquina
        Dim GetUserN
        Dim ObjNetwork
        Set ObjNetwork = CreateObject("WScript.Network")
        GetUserN = ObjNetwork.UserName
        UsuarioRede = GetUserN
    End Function
    
    __________________________________________________________________________________________
    MÓDULO 4
    ‘Gerar o Arquivo em Word
    __________________________________________________________________________________________
    
    ‘ATIVA SLEEP:
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    
    __________________________________________________________________________________________
    
    Sub GERADOC()
    'O botão GERAR TERMOS chama essa macro
    
    'Conta quantos arquivos tem na pasta
    Dim xFolder As String
    Dim xPath As String
    Dim xCount As Long
    Dim xFiDialog As FileDialog
    Dim xFile As String
    xFolder = "C:\CAMINHO\"
    If xFolder = "" Then Exit Sub
    xPath = xFolder & "\*.docx"
    xFile = Dir(xPath)
    Do While xFile <> ""
    xCount = xCount + 1
    xFile = Dir()
    Loop
            
    'Abrir o Word:
    Application.ScreenUpdating = False
    
    Dim PS As Worksheet
    Dim linha As Variant
    
    Set PS = ThisWorkbook.Worksheets("plan3")
    UltimaLinha = PS.Cells(PS.Rows.Count, "A").End(xlUp).Row
    
    ThisWorkbook.Worksheets("plan3").Activate
    
    Termo = Cells(UltimaLinha, 1).Value
    
        Dim Word As Word.Application
        Dim DOC As Word.Document
        
        Set Word = CreateObject("Word.Application")
        Word.Visible = True
        
        Do While UltimaLinha > 1
        
        If Termo = "Plano Qualificado" Then
            Set DOC = Word.Documents.Open("C:\CAMINHO\Modelo_Plano Qualificado.docx")
                
            'Sleep 8000
            
            'PreencheDOC
            Nome = Cells(UltimaLinha, 2).Value
            CPF = Cells(UltimaLinha, 6).Value
            Produto1 = Cells(UltimaLinha, 4).Value
            Produto2 = Cells(UltimaLinha, 5).Value
        
            '#Nome
            If DOC.FormFields(1).Type = wdFieldFormTextInput Then
            DOC.FormFields(1).Result = Nome
            End If
            
            '#CPF
            If DOC.FormFields(2).Type = wdFieldFormTextInput Then
            DOC.FormFields(2).Result = CPF
            End If
        
            '#PRODUTO1
            If DOC.FormFields(3).Type = wdFieldFormTextInput Then
            DOC.FormFields(3).Result = Produto1
            End If
        
            '#PRODUTO2
            If DOC.FormFields(4).Type = wdFieldFormTextInput Then
            DOC.FormFields(4).Result = Produto2
            End If
            
            'Código:
            Dim Cod As String
            Cod = "#" & "000" & xCount
            
            Endereço = "C:\CAMINHO\"
            
            DOC.SaveAs Endereço & Cod & "-" & Termo & "-" & Nome & "-" & Produto1 & "-" & Produto2
            
            Sleep 1000
            
            DOC.Close _
            SaveChanges:=False
            
            xCount = xCount + 1
            
            End If
            
        If Termo = "Proposta de Contratação" Then
            Set DOC = Word.Documents.Open("C:\CAMINHO\Modelo_Proposta de Contratação.docx")
            'Sleep 3000
            
             'PreencheDOC
            Nome = Cells(UltimaLinha, 2).Value
            CPF = Cells(UltimaLinha, 6).Value
            Produto1 = Cells(UltimaLinha, 4).Value
            Produto2 = Cells(UltimaLinha, 5).Value
        
            '#Nome
            If DOC.FormFields(1).Type = wdFieldFormTextInput Then
            DOC.FormFields(1).Result = Nome
            End If
            
            '#CPF
            If DOC.FormFields(2).Type = wdFieldFormTextInput Then
            DOC.FormFields(2).Result = CPF
            End If
        
            '#PRODUTO1
            If DOC.FormFields(3).Type = wdFieldFormTextInput Then
            DOC.FormFields(3).Result = Produto1
            End If
        
            '#PRODUTO2
            If DOC.FormFields(4).Type = wdFieldFormTextInput Then
            DOC.FormFields(4).Result = Produto2
            End If
            
            'Código:
            Cod = "#" & "000" & xCount
            
            Endereço = "C:\CAMINHO\"
            
            DOC.SaveAs Endereço & Cod & "-" & Termo & "-" & Nome & "-" & Produto1 & "-" & Produto2
            
            Sleep 1000
            
            DOC.Close _
            SaveChanges:=False
            
            xCount = xCount + 1
            
            End If
            
        If Termo = "Termo de Opção" Then
            Set DOC = Word.Documents.Open("C:\CAMINHO\Modelo_Termo de Opção.docx")
            'Sleep 3000
            
             'PreencheDOC
            Nome = Cells(UltimaLinha, 2).Value
            CPF = Cells(UltimaLinha, 6).Value
            Produto1 = Cells(UltimaLinha, 4).Value
            Produto2 = Cells(UltimaLinha, 5).Value
        
            '#Nome
            If DOC.FormFields(1).Type = wdFieldFormTextInput Then
            DOC.FormFields(1).Result = Nome
            End If
            
            '#CPF
            If DOC.FormFields(2).Type = wdFieldFormTextInput Then
            DOC.FormFields(2).Result = CPF
            End If
        
            '#PRODUTO1
            If DOC.FormFields(3).Type = wdFieldFormTextInput Then
            DOC.FormFields(3).Result = Produto1
            End If
        
            '#PRODUTO2
            If DOC.FormFields(4).Type = wdFieldFormTextInput Then
            DOC.FormFields(4).Result = Produto2
            End If
            
            'Código:
            Cod = "#" & "000" & xCount
            
            Endereço = "C:\CAMINHO\"
            
            DOC.SaveAs Endereço & Cod & "-" & Termo & "-" & Nome & "-" & Produto1 & "-" & Produto2
            
            Sleep 1000
            
            DOC.Close _
            SaveChanges:=False
            
            xCount = xCount + 1
            
            End If
            
        UltimaLinha = UltimaLinha - 1
        
    Loop
    
    Word.Application.Quit
    ThisWorkbook.Worksheets("plan1").Activate
    Application.ScreenUpdating = True
    MsgBox ("Finalizado")
            
    End Sub
    
    
    
    
    


    domingo, 13 de janeiro de 2019 22:07

Respostas

  • 'VERIFICAÇÕES:
        'Menor
    ThisWorkbook.Sheets("plan1").Activate
    Nome = Cells(6, 3).Value
        If Nome <> "" Then
            x = 1
        End If
    NomeMenor = Cells(12, 3).Value
            If NomeMenor <> "" Then
            y = 1
        End If
    If x + y = 2 Then
        MsgBox "msg1"
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
    End If
    
       'PGBL X VGBL
    ThisWorkbook.Sheets("plan1").Activate
    VerOrigem = Cells(9, 6).Value
    
    VerDestino = Cells(9, 9).Value
    
    If VerOrigem <> VerDestino Then
        MsgBox ("msg2")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
    
    'Regime
    ThisWorkbook.Sheets("plan1").Activate
    Origem_Regressivo = Cells(10, 13).Value
        If Origem_Regressivo = False Then
            W = 1
        End If
    Origem_Progressivo = Cells(11, 13).Value
        If Origem_Progressivo = False Then
            Z = 1
        End If
    Destino_Regressivo = Cells(12, 13).Value
        If Destino_Regressivo = False Then
            K = 1
        End If
    Destino_Progressivo = Cells(13, 13).Value
        If Destino_Progressivo = False Then
            J = 1
        End If
        
    If W + Z + K + J = 4 Then
        MsgBox ("msg3")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
    
    If Origem_Regressivo = Origem_Progressivo Then
        MsgBox ("msg4")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
        
    If Destino_Regressivo = Destino_Progressivo Then
        MsgBox ("msg5")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
            
    If Origem_Regressivo = Destino_Progressivo Then
        MsgBox ("msg6")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If

    terça-feira, 15 de janeiro de 2019 02:15
  • If NomeMenor <> "" Then
                Nome = NomeMenor
            End If
    terça-feira, 15 de janeiro de 2019 02:16
  • Olá amigo,

    Você pode criar uma conta no DevOps gratuita para armazenamento do seu fonte.

    https://aex.dev.azure.com

    Ou voc:e pode guardar no Github 

    https://github.com

    Algum moderador do site pode remover seu código por não ser uma pergunta ok.

    Abraços.

    Não esqueça de marcar como respondido pra dar aquela força...

    e se escreve no meu canal, bastante videos de tudo que está utilizando muito no mercado hoje em dia.

    Abraços.

    https://www.youtube.com/channel/UCQpk_XT9AUYjd2mUqW1wkpw?view_as=subscriber 

    terça-feira, 15 de janeiro de 2019 17:12

Todas as Respostas

  • 'VERIFICAÇÕES:
        'Menor
    ThisWorkbook.Sheets("plan1").Activate
    Nome = Cells(6, 3).Value
        If Nome <> "" Then
            x = 1
        End If
    NomeMenor = Cells(12, 3).Value
            If NomeMenor <> "" Then
            y = 1
        End If
    If x + y = 2 Then
        MsgBox "msg1"
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
    End If
    
       'PGBL X VGBL
    ThisWorkbook.Sheets("plan1").Activate
    VerOrigem = Cells(9, 6).Value
    
    VerDestino = Cells(9, 9).Value
    
    If VerOrigem <> VerDestino Then
        MsgBox ("msg2")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
    
    'Regime
    ThisWorkbook.Sheets("plan1").Activate
    Origem_Regressivo = Cells(10, 13).Value
        If Origem_Regressivo = False Then
            W = 1
        End If
    Origem_Progressivo = Cells(11, 13).Value
        If Origem_Progressivo = False Then
            Z = 1
        End If
    Destino_Regressivo = Cells(12, 13).Value
        If Destino_Regressivo = False Then
            K = 1
        End If
    Destino_Progressivo = Cells(13, 13).Value
        If Destino_Progressivo = False Then
            J = 1
        End If
        
    If W + Z + K + J = 4 Then
        MsgBox ("msg3")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
    
    If Origem_Regressivo = Origem_Progressivo Then
        MsgBox ("msg4")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
        
    If Destino_Regressivo = Destino_Progressivo Then
        MsgBox ("msg5")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If
            
    If Origem_Regressivo = Destino_Progressivo Then
        MsgBox ("msg6")
        MsgBox "DADOS NÃO ARMAZENADOS", vbCritical
        Exit Sub
        End If

    terça-feira, 15 de janeiro de 2019 02:15
  • If NomeMenor <> "" Then
                Nome = NomeMenor
            End If
    terça-feira, 15 de janeiro de 2019 02:16
  • Ok, obrigada pela dica!
    terça-feira, 15 de janeiro de 2019 22:45