Excel VBA_Gravando Dados Condicionais x Células Vazias

[guicrissantos]

Boa Noite!

Tenho uma planilha de vendas as quais, cada operador deve se identificar obrigatoriamente e lançar manualmente seus pontos por venda e o restante a planilha já calcula porém, preciso de duas macros sendo:

 

Uma que traz a mensagem para o vendedor operador se identificar caso ele tente lançar a pontuação sem ter colocado seu nome na coluna "E" e

outra para o botão GRAVAR DADOS que transportada os resultados para a guia BANCODEDADOS.

 

Se alguém puder me auxiliar, deixo anexo a planilha em questão.

 

Desde já, agradeço.

VBA GRAVAR DADOS E CÉLULA VAZIA.xlsx

[Muca Costa]

Tente assim:

Click lado direito na aba OPERAÇÕES/Exibir Código, incluir o evento abaixo:

 

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Column = 7 Then
        ThisRow = Target.Row
        If Range("E" & ThisRow) = "" Then
           MsgBox "Informe o Operador"
           Range("E" & ThisRow).Select
           Exit Sub
        End If
    End If
End Sub

 

Em um Módulo:

 

Sub Gravar()
Dim Ul As String, i As Integer
    Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To Ul
        If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then
        Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7)
        Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5)
        Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4)
        Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13)
        End If
    Next
        Range("B6").Select
        MsgBox "FIM"
End Sub

 

[guicrissantos]

@Muca Costa muito obrigado pela ajuda.

 

Funcionou porém, gostaria de te pedir dois favores (se possível).

Primeiro:

Poderia por favor descrever para mim o que significa cada informação do código para eu entender e adaptar em outra planilha aqui. Por exemplo: Quero entender o que significa:

 

If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then

Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7)

 

Segundo:

No primeiro código, ao inserir a pontuação, chama a macro que solicitação inserção do operador porém...

após realizar isso tudo, antes de clicar no botão gravar, existe um botão que oculta as linhas em branco. 

Tendo ocultado, executa a gravação.

Após gravar, tem um botão que limpa os dados e reabilita as linhas que fora ocultadas anteriormente. Neste momento como vai ocultar os pontos inseridos pelo operador, a macro é chamada novamente para informar o operador. 

Poderia por favor adaptar esse primeiro código de modo que chama a macro apenas ao tentar inserir a pontuação sem o nome do operador? Uma vez inserida, se tentar apagar os dados (pontuação e nome do operador) não precisa chamar a macro novamente.

 

Desde já, obrigado.

[Muca Costa]

Primeiro:

 

Sub Gravar()
Dim Ul As String, i As Integer
    Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row 'Conta linhas preenchidas em B Aba BANCODEDADOS
    For i = 2 To Ul 'Busca, em BANCO DE DADOS, a data correspondente a B6 de OPERAÇÕES
        If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then 'Se em linha (i) & coluna B de BANCODEDADOS for igual a B6 de OPERAÇÕES, grava os dados
        Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7) 'linha (i) & coluna F de BANCODEDADOS igual a G4 de OPERAÇÕES
        Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5) 'linha (i) & coluna R de BANCODEDADOS igual a E4 de OPERAÇÕES
        Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4) 'linha (i) & coluna S de BANCODEDADOS igual a D4 de OPERAÇÕES
        Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13) 'linha (i) & coluna T de BANCODEDADOS igual a M4 de OPERAÇÕES
        End If
    Next
        Range("B6").Select
        MsgBox "FIM"
End Sub

Segundo:

Muito confuso, não entendi...

[guicrissantos]

@Muca Costa Só tenho a agradecer.

Depois que eu entendi o que cada código faz, eu adaptei na minha planilha e deu certinho.

Muito obrigado mesmo.

 

Muca, tendo em vista que deu certinho, estou com a seguinte situação.

 

Tenho três botões na planilha (TODOS FUNCIONANDO) a saber:

 

• BOTÃO GRAVAR DADOS (Que é exatamente esse código que você criou para mim);
• BOTÃO OCULTAR LINHAS (Oculta as linhas não preenchidas da planilha e salva o relatório PDF automaticamente);
• BOTÃO LIMPAR DADOS E REATIVAR LINHAS (Que limpa os dados preenchidos DEPOIS DE GRAVADOS NO BANCO DE DADOS, liberando a planilha para o trabalho do dia seguinte).

Atualmente esses botões são acionados manualmente e separadamente.

 

Tudo que eu queria fazer era juntar todos esses comandos no BOTÃO GRAVAR ou seja, quando o operador clicar no BOTÃO GRAVAR, a planilha...

• GRAVA NO BANCO DE DADOS;
• OCULTA AS LINHAS NÃO PRENCHIDAS;
• SALVA O PDF AUTOMÁTICO;
• ...E JÁ LIMPA OS DADOS PREENCHIDOS.

 

Se tiver como me ajudar nisso, temos apenas UM DETALHE A SER ACRESCENTADO:

 

Ao clicar no BOTÃO GRAVAR, deverá vir uma MSGBOX dizendo:

"Você está encerrando os lançamentos do dia. Tem certeza que deseja prosseguir com a gravação?".

 

Optando por SIM, deverá vir outra MSGBOX alertando:

 

Citação

If MsgBox "APÓS A GRAVAÇÃO, TODOS SEUS DADOS SERÃO APAGADOS. DESEJA REALMENTE APAGAR TODOS OS LANÇAMENTOS?" & Chr(13) & Chr(13) & "ATENÇÃO pois, não será possivel desfazer esta ação.", vbYesNo + vbQuestion, "LIMPAR TUDO") = vbYes Then

 

Muca, se puder me ajudar nisso, ficarei grato.

Deixo abaixo os código que já estão funcionado apenas para junção dos mesmos.

 

GRAVAR DADOS

 

Private Sub GravarDados_Click()
Dim Ul As String, i As Integer
    Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row 'Conta linhas preenchidas em B Aba BANCODEDADOS
    For i = 2 To Ul 'Busca, em BANCO DE DADOS, a data correspondente a B6 de OPERAÇÕES
        If Planilha11.Cells(i, 2) = Planilha9.Cells(12, 2) Then 'Se em linha (i) & coluna B de BANCODEDADOS for igual a B12 de OPERAÇÕES, grava os dados
        Planilha11.Cells(i, 6) = Planilha9.Cells(5, 13) 'linha (i) & coluna F de BANCODEDADOS igual a M5 de OPERAÇÕES
        Planilha11.Cells(i, 18) = Planilha9.Cells(3, 13) 'linha (i) & coluna R de BANCODEDADOS igual a M3 de OPERAÇÕES
        Planilha11.Cells(i, 19) = Planilha9.Cells(3, 10) 'linha (i) & coluna S de BANCODEDADOS igual a J3 de OPERAÇÕES
        Planilha11.Cells(i, 20) = Planilha9.Cells(3, 16) 'linha (i) & coluna T de BANCODEDADOS igual a P3 de OPERAÇÕES
        End If
    Next
        Range("B12").Select
        MsgBox "Dados Gravados com Sucesso!", vbInformation, "REGISTRANDO DADOS"
End Sub

 

 

OCULTA LINHAS E SALVA PDF

 

Private Sub OcultarLinhasBC_Click()
    OcultarLinhasBC.BackColor = &H0&
        Application.ScreenUpdating = False
    For Each xRg In Range("G13:G162")
        If xRg.Value = "" Then
            xRg.EntireRow.Hidden = True
        End If
Next xRg
    LimparDadosReativarLinhas.Enabled = True
    OcultarLinhasBC.Enabled = False
    
Selection.End(xlDown).Select
    ActiveWindow.SmallScroll Down:=-102
    ChDir _
        "D:\998_Google Drive\000_PROVISÓRIO"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "D:\998_Google Drive\000_PROVISÓRIO\" & Range("B168") & "_" & Format(Now, "yyyymmdd_hhmmss") _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True
    ActiveWindow.SmallScroll Down:=-24
    Range("G13").Select
End Sub

 

 

LIMPA DADOS E REATIVA LINHAS OCULTADAS ANTERIORMENTE

 

Private Sub LimparDadosReativarLinhas_Click()
LimparDadosReativarLinhas.BackColor = &HFFFF&
    If MsgBox("DESEJA REALMENTE APAGAR TODOS OS LANÇAMENTOS?" & Chr(13) & Chr(13) & "ATENÇÃO pois, não será possivel desfazer esta ação.", vbYesNo + vbQuestion, "LIMPAR TUDO") = vbYes Then
        Range("E13:E162,G13:G162").Select
        Range("G13").Activate
        Selection.ClearContents
        Range("G13").Select
    Rows("13:162").EntireRow.Hidden = False
    OcultarLinhasBC.Enabled = True
    LimparDadosReativarLinhas.Enabled = False
    End If
End Sub

 

 

Deus abençoe e muito obrigado.

No aguardo,

Guilherme

[Muca Costa]

Private Sub Gravar()
Dim Ul As String, i As Integer, x As Integer
    
    x = MsgBox("APÓS A GRAVAÇÃO, TODOS SEUS DADOS SERÃO APAGADOS. DESEJA REALMENTE APAGAR TODOS OS LANÇAMENTOS?" & Chr(13) & Chr(13) & "ATENÇÃO pois, não será possivel desfazer esta ação.", vbYesNo + vbQuestion, Title:="© Muca Sistemas - 2021")
    If x <> vbYes Then
    Exit Sub
    End If
    
    Ul = Planilha11.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To Ul
        If Planilha11.Cells(i, 2) = Planilha9.Cells(6, 2) Then
        Planilha11.Cells(i, 6) = Planilha9.Cells(4, 7)
        Planilha11.Cells(i, 18) = Planilha9.Cells(4, 5)
        Planilha11.Cells(i, 19) = Planilha9.Cells(4, 4)
        Planilha11.Cells(i, 20) = Planilha9.Cells(4, 13)
        End If
    Next
    
        OcultarLinhasBC_Click
        LimparDadosReativarLinhas_Click
        
        Range("B12").Select
        MsgBox "Dados Gravados com Sucesso!", vbInformation, "REGISTRANDO DADOS"
End Sub

 

[guicrissantos]

@Muca Costa Sr. Muca...

Os dizeres e células são exatamente as que mencionei nos tres códigos acima.

Só preciso que unifique-as por favor. 

Copiei e colei este seu último e substitui no meu código, mas estão dando erro.

 

32 minutos atrás, Muca Costa disse:

OcultarLinhasBC_Click

 Está dando: 

Erro de compilação:

'Sub' ou 'Function' não definida.

 

 

[Muca Costa]

Essas linhas:

		OcultarLinhasBC_Click
        LimparDadosReativarLinhas_Click

Tem que ter o mesmo nome das sub's que ocultam, limpam e reativam...

[guicrissantos]

27 minutos atrás, Muca Costa disse:

Tem que ter o mesmo nome das sub's que ocultam, limpam e reativam...

Sim, mas a ideia é eliminar os dois botões (OCULTAR) e (REATIVAR) e concentrar tudo num unico botão "GRAVAR DADOS"

 

Se eu tiver entendido errado, o que eu preciso alterar para dar certo?

[Muca Costa]

guicrissantos,

você não está percebendo que está concentrado tudo na sub Gravar?

O evento, após gravar, chama os outras Sub's; tudo em um só botão...

 

Inclusive pode retirar o "_Click" das Sub's

[guicrissantos]

@Muca Costa Entendido e resolvido.

Deu certinho agora meu amigo.

Tudo funcionando perfeitamente.

 

Muito obrigado pela atenção.

Sucesso.