Chebox para selecionar linha de dados a ser gravados

2024 - VBA & Macros

Post Recente por srobles 5 anos atrás

3 Posts

3 Usuários

0 Reactions

1,362 Visualizações

RSS

kaioaraujo

(@kaioaraujo)

Posts: 2

New Member

Topic starter

A Questão é o seguinte sou novo com vba então o que quero fazer me parece ser mais complicado do que penso (ou não).
Quero inserir 4 checkbox para quando apertar o botão salvar, gravar somente os dados da células onde a checkbox esta ticada, tiver o value= True (eu acho que seja isso), mas que se não tiver nenhum checkbox ticado ele retorna MsgBox "Lorem Ipsum". Enfim a chebox fica entre a celulas A12 A14 A16 A18 e os dados ficam de B12:S12 e assim nas outras linha como o código abaixo.

Sub exe()

    Dim Home As Worksheet, Dados As Worksheet, DBPDF As Worksheet
    Dim ulD As Double
    
    Set Home = Sheets("Home")
    Set Dados = Sheets("Dados")
    Set DBPDF = Sheets("DBPDF")
    
    'Condições If 1'
    
        If Home.Cells(12, 2) <> " " And Home.Cells(12, 4) <> " " And Home.Cells(12, 9) <> " " _
        And Home.Cells(12, 13) <> " " And Home.Cells(12, 14) <> " " And Home.Cells(12, 16) <> " " And Home.Cells(12, 18) <> " " _
        And Home.Cells(12, 19) <> " " And Home.Cells(12, 19) = "Sem Dados" Then

            MsgBox "Ops! Falta campos a ser preenchido. 1"

        Else
    
        
        If Home.Cells(14, 2) <> " " And Home.Cells(14, 4) <> " " And Home.Cells(14, 9) <> " " _
        And Home.Cells(14, 13) <> " " And Home.Cells(14, 14) <> " " And Home.Cells(14, 16) <> " " And Home.Cells(14, 18) <> " " _
        And Home.Cells(14, 19) <> " " And Home.Cells(14, 19) = "Sem Dados" Then

            MsgBox "Ops! Falta campos a ser preenchido. 2"
        
        Else
        
    
        
        If Home.Cells(16, 2) <> " " And Home.Cells(16, 4) <> " " And Home.Cells(16, 9) <> " " _
        And Home.Cells(16, 13) <> " " And Home.Cells(16, 14) <> " " And Home.Cells(16, 16) <> " " And Home.Cells(16, 18) <> " " _
        And Home.Cells(16, 19) <> " " And Home.Cells(16, 19) = "Sem Dados" Then

            MsgBox "Ops! Falta campos a ser preenchido. 3"

        Else
    
    
        
        If Home.Cells(18, 2) <> " " And Home.Cells(18, 4) <> " " And Home.Cells(18, 9) <> " " _
        And Home.Cells(18, 13) <> " " And Home.Cells(18, 14) <> " " And Home.Cells(18, 16) <> " " And Home.Cells(18, 18) <> " " _
        And Home.Cells(18, 19) <> " " And Home.Cells(18, 19) = "Sem Dados" Then

            MsgBox "Ops! Falta campos a ser preenchido. 4"

        Else
    
'    'Salvar'
    
        For x = 12 To 18

        If Home.Cells(x, 19).Value = "Sem Dados" Then '<--If 2'
            'MsgBox "OK"
            
        Else
       
        ulD = Dados.Cells(Rows.Count, 2).End(xlUp).Row '<-- Pula Linhas'
        vlD = DBPDF.Cells(Rows.Count, 1).End(xlUp).Row
        
        Dados.Cells(ulD + 1, 2) = Home.Cells(x, 2).Value
        DBPDF.Cells(vlD + 1, 1) = Home.Cells(x, 2).Value
        
        Dados.Cells(ulD + 1, 4) = Home.Cells(x, 4).Value
        DBPDF.Cells(vlD + 1, 2) = Home.Cells(x, 4).Value
        
        Dados.Cells(ulD + 1, 9) = Home.Cells(x, 9).Value
        DBPDF.Cells(vlD + 1, 3) = Home.Cells(x, 9).Value
        
        Dados.Cells(ulD + 1, 13) = Home.Cells(x, 13).Value
        DBPDF.Cells(vlD + 1, 4) = Home.Cells(x, 13).Value
        
        Dados.Cells(ulD + 1, 14) = Home.Cells(x, 14).Value
        DBPDF.Cells(vlD + 1, 5) = Home.Cells(x, 14).Value
        
        Dados.Cells(ulD + 1, 16) = Home.Cells(x, 16).Value
        DBPDF.Cells(vlD + 1, 6) = Home.Cells(x, 16).Value
        
        Dados.Cells(ulD + 1, 18) = Home.Cells(x, 18).Value
        DBPDF.Cells(vlD + 1, 7) = Home.Cells(x, 18).Value
        
        
        Dados.Cells(ulD + 1, 19) = Home.Cells(x, 19).Value
        DBPDF.Cells(vlD + 1, 8) = Home.Cells(x, 19).Value
        
        'Limpa Cells'
        
        'Home.Cells(x, 2).Value = Empty
        'Home.Cells(x, 4).Value = Empty
        'Home.Cells(x, 9).Value = Empty
       ' Home.Cells(x, 13).Value = Empty
        'Home.Cells(x, 14).Value = Empty
        'Home.Cells(x, 16).Value = Empty
        'Home.Cells(x, 18).Value = Empty
        'Home.Cells(x, 19).Value = Empty
        
        End If '<-- If 2'
        
        Next x '<--End For'
        
        End If '<-- If 1'
        End If '<-- If 1'
        End If '<-- If 1'
        End If '<-- If 1

End Sub

Postado : 02/11/2019 12:50 pm

FarahA

(@faraha)

Posts: 28

Eminent Member

Kaio, boa tarde!

Ficou um pouco difícil de entender onde quer que sejam "inputados" os dados somente pelo código, conseguiria enviar um modelo através de um site de compartilhamento(ex: sendspace), ficaria mais fácil para lhe dar uma resposta mais acertiva.

Espero pode lhe ajudar.

Postado : 02/11/2019 3:49 pm

srobles

(@srobles)

Posts: 231

Estimable Member

kaioaraujo,

Como não especificou se está utilizando controles de Formulário ou ActiveX, elaborei a rotina usando controles de Formulário.

Favor, veja se a modificação abaixo atende sua necessidade.

Lembre-se apenas de mover sua rotina para um bloco de notas antes de substituir pela que deixo.

Sub ctlFormulario()
    Dim nomeControle As String
    Dim ctlControle As Shape
    Dim contador As Long
    
    contador = 0
    
    With ThisWorkbook.Sheets("Home")
    
        .Activate
        
        For Each ctlControle In ActiveSheet.Shapes
            nomeControle = ctlControle.Name
            If nomeControle Like "*Check Box*" Then
                '1 para True e -4146 para False
                If ctlControle.ControlFormat.Value = 1 Then
                    contador = contador + 1
                End If
            End If
            
        Next
        
        If contador = 4 Then
            Call exe
        Else
            MsgBox "Lorem Ipsum!", vbExclamation, "Validação"
        End If
    End With
End Sub

Sub exe()
    
    Dim Home As Worksheet, Dados As Worksheet, DBPDF As Worksheet
    Dim ulD As Long
   
    Set Home = Sheets("Home")
    Set Dados = Sheets("Dados")
    Set DBPDF = Sheets("DBPDF")
   
    
        For x = 12 To 18
           
            ulD = Dados.Cells(Rows.Count, 2).End(xlUp).Row  '<-- Pula Linhas'
            vlD = DBPDF.Cells(Rows.Count, 1).End(xlUp).Row
           
            Dados.Cells(ulD + 1, 2) = Home.Cells(x, 2).Value
            DBPDF.Cells(vlD + 1, 1) = Home.Cells(x, 2).Value
           
            Dados.Cells(ulD + 1, 4) = Home.Cells(x, 4).Value
            DBPDF.Cells(vlD + 1, 2) = Home.Cells(x, 4).Value
           
            Dados.Cells(ulD + 1, 9) = Home.Cells(x, 9).Value
            DBPDF.Cells(vlD + 1, 3) = Home.Cells(x, 9).Value
           
            Dados.Cells(ulD + 1, 13) = Home.Cells(x, 13).Value
            DBPDF.Cells(vlD + 1, 4) = Home.Cells(x, 13).Value
           
            Dados.Cells(ulD + 1, 14) = Home.Cells(x, 14).Value
            DBPDF.Cells(vlD + 1, 5) = Home.Cells(x, 14).Value
           
            Dados.Cells(ulD + 1, 16) = Home.Cells(x, 16).Value
            DBPDF.Cells(vlD + 1, 6) = Home.Cells(x, 16).Value
           
            Dados.Cells(ulD + 1, 18) = Home.Cells(x, 18).Value
            DBPDF.Cells(vlD + 1, 7) = Home.Cells(x, 18).Value
           
           
            Dados.Cells(ulD + 1, 19) = Home.Cells(x, 19).Value
            DBPDF.Cells(vlD + 1, 8) = Home.Cells(x, 19).Value
           
        Next
        
        'Limpa Cells'
       
        Home.Cells(x, 2).Value = Empty
        Home.Cells(x, 4).Value = Empty
        Home.Cells(x, 9).Value = Empty
        Home.Cells(x, 13).Value = Empty
        Home.Cells(x, 14).Value = Empty
        Home.Cells(x, 16).Value = Empty
        Home.Cells(x, 18).Value = Empty
        Home.Cells(x, 19).Value = Empty
       
        MsgBox "Cadastro realizado com sucesso!", vbInformation, "Cadastro"
End Sub

Espero ter ajudado.

Abs.

Saulo Robles

Postado : 05/11/2019 3:41 pm