locked
Confirmar se dados de formulário foram entrados na planilha RRS feed

  • Pergunta

  • 'Bom dia a todos! Tenho um userform que tem 64 textboxs e 1 DTPicker1 que contém valores que são cadastrados na planilha! Séria possível algum outro código comparar esses valores do userform nas células na planilha! Como se fosse uma confirmação de cadastro! Sei que poderia usar uma msgbox! mas queria um código que comparasse! 
    'Cria a variavel linhavazia
    Dim linhavazia As Long
    Sheets("PLAN1").Select
    
    
    'conta quantas informações foram inseridas na coluna A da aba dados
    linhavazia = WorksheetFunction.CountA(Range("A:A")) + 1
    
    'Insere informações da aba dados
    Cells(linhavazia, 1).Value = DTPicker1.Value
    Atenciosamente! Gênises



    sexta-feira, 11 de março de 2016 10:14

Respostas

  • Pode usar o código abaixo para fazer backup:

    Sub CriarBackup()
        Dim BackupPath As String
        
        If MsgBox("Deseja salvar alterações", _
                  vbYesNo + vbQuestion, _
                  "Fechar a Aplicação") = vbYes Then
            ThisWorkbook.Save
        End If
        
        If MsgBox("Deseja realizar um backup? Criarplan desenvolvimento de sistemas com o excel e vba não se responsabiliza por perca de dados se não for realizado um backup?", _
                  vbYesNo + vbQuestion, _
                  "Fechar a Aplicação") = vbYes Then
            BackupPath = ThisWorkbook.Path & "\" & _
                         Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & " " & _
                         Format(Now, "yyyy-mm-dd hh.mm.ss") & ".xlsm"
            ThisWorkbook.SaveCopyAs BackupPath
            MsgBox "Backup Salvo!", vbInformation
        End If
    End Sub
    

    ---

    Cara, seu código está insustentável. Antes de mais nada, você precisa compilá-lo e acertar todos os erros.

    Também, verifique a indentação do código.

    Não se esqueça de utilizar as tags de código ao postar código aqui.

    Indente seu código e verifique se ele está compilando com sucesso.


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    • Marcado como Resposta Gênises sábado, 12 de março de 2016 12:03
    sexta-feira, 11 de março de 2016 19:45
    Moderador

Todas as Respostas

  • Poderia explicar com mais clareza? Não entendi o que pretende fazer.

    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    sexta-feira, 11 de março de 2016 13:12
    Moderador
    • Boa tarde! quero confirmar se os dados do userform foram incluidos na planila! tipo uma comparação teria como?
    • Obrigado pela atenção!
    sexta-feira, 11 de março de 2016 15:08
  • Gênises,

    Em termos de arquitetura, isso não se faz em sistemas cujos dados se encontram no mesmo local físico da ferramenta. Em outras palavras: é desnecessário fazer essa checagem. Ao invés disso, que tal certificar-se que a rotina de salvar os dados não falhe?

    Qual é a rotina para salvar dados que você usa, poderia postar?


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    sexta-feira, 11 de março de 2016 17:32
    Moderador
  • Boa tarde! Obrigado pela atenção! a minha preocupação é se é possivel ao executar o código ele falhar e não apresentar nenhuma mensagem de erro! 

    A rotina que uso é de um backup! mas se código de cadastro falhar e não exibir uma mensagem de erro! então mesmo que eu faça um backup! não vai adiantar!

    O meu código de backup é esse!

    'não deixar que exiba a mensagem se quer que salve ou não! Application.DisplayAlerts = False

    Dim DECISÃO As Variant Dim salvar As Variant salvar = MsgBox("Deseja salvar alterações", vbYesNo + vbQuestion, "fechar a aplicação") If salvar = vbYes Then 'salvar " ActiveWorkbook.Save 'fim Else End If

    DECISÃO = MsgBox("Deseja realizar um backup? Criarplan desenvolvimento de sistemas com o excel e vba não se responsabiliza por perca de dados se não for realizado um backup?", vbYesNo + vbQuestion, "fechar a aplicação") If DECISÃO = vbYes Then 'CÓDIGO PARA REALIZAR BACKUP Dim newWB As Variant Dim wb1 As Workbook, wb2 As Workbook Set wb1 = ActiveWorkbook If wb1.Saved = False Then MsgBox wb1.FullName, vbInformation, "Workbook Not Saved" 'Set a filename for new workbook newWB = Application.GetSaveAsFilename(ActiveWorkbook.FullName, "Excel Files (*.xlsm), *.xlsm", , "Set Filename") If newWB <> False Then wb1.SaveCopyAs (newWB) MsgBox ("OK!"), vbInformation 'FIM Else End If

    Application.Visible = True Application.Workbooks("SOFTWAREAMORIM.xlsm").Close End If

    O meu código de cadastro é esse! ele é muito extenso e não tenho como conferir se as informações foram inseridas na planilha!

    Sheets("plan67").Select
    Sheets("PLAN67").Range("A1") = DTPicker1.Value


    TextBox209.Value = DTPicker1
    TextBox209.Value = Application.Substitute(TextBox209.Value, "/", "-")

    TextBox208.Value = Sheets("plan23").Range("Y2")
    TextBox203.Value = Sheets("plan23").Range("k19")
    TextBox202.Value = Sheets("plan23").Range("E19")
    TextBox204.Value = Sheets("plan23").Range("H7")
    TextBox201.Value = Sheets("plan23").Range("C19")
    TextBox206.Value = Sheets("PLAN23").Range("V10")
    TextBox207.Value = Sheets("plan23").Range("K20")
    With Me.TextBox208
        
        .Value = Format(.Value, "HH:MM:SS")
    End With

    If OptionButton3 = False And OptionButton2 = False Then
    MsgBox ("SELECIONE A QTD DE SAIDAS DA MAROMBA!"), vbCritical
    Exit Sub
    End If



    If TextBox200.Value = "" Then
    MsgBox ("Marque antes a data!"), vbCritical, "criarplan"

    Else
    'MACRO GERAR PDF E SALVAR EM PASTA"
    On Error Resume Next
    Dim i As Long
    Dim Pasta As String, MyPath As String

    'DECLARAÇÃO PROGRESS BAR
    Dim pctCompl As Single
    'FIM

    Dim Ans
        Ans = MsgBox("DESEJA CONFIRMAR O CADASTRO?" & Chr(13) & "" & Chr(13) & "", vbOKCancel)
        If Ans = vbOK Then

        



    pctCompl = 1
    C pctCompl




    'CODIGO TROCA VIRUGULA POR PONTO'
    TextBox64.Value = Application.Substitute(TextBox64.Value, ",", ".")
    TextBox67.Value = Application.Substitute(TextBox67.Value, ",", ".")
    TextBox190.Value = Application.Substitute(TextBox190.Value, ",", ".")

    TextBox177.Value = Application.Substitute(TextBox177.Value, ",", ".")
    TextBox178.Value = Application.Substitute(TextBox178.Value, ",", ".")
    TextBox179.Value = Application.Substitute(TextBox179.Value, ",", ".")
    TextBox180.Value = Application.Substitute(TextBox180.Value, ",", ".")
    TextBox181.Value = Application.Substitute(TextBox181.Value, ",", ".")
    TextBox182.Value = Application.Substitute(TextBox182.Value, ",", ".")
    TextBox183.Value = Application.Substitute(TextBox183.Value, ",", ".")
    TextBox184.Value = Application.Substitute(TextBox184.Value, ",", ".")
    TextBox185.Value = Application.Substitute(TextBox185.Value, ",", ".")
    TextBox186.Value = Application.Substitute(TextBox186.Value, ",", ".")
    TextBox187.Value = Application.Substitute(TextBox187.Value, ",", ".")
    TextBox188.Value = Application.Substitute(TextBox188.Value, ",", ".")
    TextBox189.Value = Application.Substitute(TextBox189.Value, ",", ".")
    TextBox203.Value = Application.Substitute(TextBox203.Value, ",", ".")
    TextBox201.Value = Application.Substitute(TextBox201.Value, ",", ".")
    TextBox202.Value = Application.Substitute(TextBox202.Value, ",", ".")
    TextBox204.Value = Application.Substitute(TextBox204.Value, ",", ".")
    TextBox208.Value = Application.Substitute(TextBox208.Value, ",", ".")
    TextBox206.Value = Application.Substitute(TextBox206.Value, ",", ".")


    pctCompl = 4
    C pctCompl

    If TextBox67.Value = "" Then

    MsgBox ("CALCULE OS MIN TRABALHADOS!"), vbCritical, "CRIARPLAN"


    ElseIf TextBox67.Value <> "" Then
    'Cria a variavel linhavazia
    Dim linhavazia As Long


    Sheets("plan63").Select


    'ESSE COD VERIFICA SE PLAN2 ESTÁ SELECIONADA E AO MESMO TEMPO SELECIONA, CASO A PLANILHA NÃO SEJA SELECIONADA APARECE UMA MENSAGEM DE ERRO
    If Worksheets("PLAN63").Activate = True Then

    'Usaremos a propriedade ActiveSheet.Name para obtermos o nome da Aba ativa (worksheet).

    'MsgBox ActiveSheet.Name, vbInformation, ActiveWorkbook.Name
    pctCompl = 30
    W pctCompl

    Else
    MsgBox ("Erro ao selecionar planilha"), vbCritical
    Exit Sub
    End If










    'conta quantas informações foram inseridas na coluna A da aba dados
    linhavazia = WorksheetFunction.CountA(Range("A:A")) + 1

    'Insere informações da aba dados
    Cells(linhavazia, 1).Value = DTPicker1.Value
    Cells(linhavazia, 2).Value = TextBox68.Value
    Cells(linhavazia, 3).Value = TextBox69.Value
    Cells(linhavazia, 4).Value = TextBox70.Value
    Cells(linhavazia, 5).Value = TextBox71.Value
    Cells(linhavazia, 6).Value = TextBox72.Value
    Cells(linhavazia, 7).Value = TextBox73.Value
    Cells(linhavazia, 8).Value = TextBox74.Value
    Cells(linhavazia, 9).Value = TextBox75.Value
    Cells(linhavazia, 10).Value = TextBox76.Value

    pctCompl = 8
    C pctCompl


    Cells(linhavazia, 11).Value = TextBox77.Value
    Cells(linhavazia, 12).Value = TextBox78.Value
    Cells(linhavazia, 13).Value = TextBox79.Value
    Cells(linhavazia, 14).Value = TextBox80.Value
    Cells(linhavazia, 15).Value = TextBox81.Value
    Cells(linhavazia, 16).Value = TextBox82.Value
    Cells(linhavazia, 17).Value = TextBox83.Value
    Cells(linhavazia, 18).Value = TextBox84.Value
    Cells(linhavazia, 19).Value = TextBox85.Value

    pctCompl = 11
    C pctCompl

    Cells(linhavazia, 20).Value = TextBox86.Value
    Cells(linhavazia, 21).Value = TextBox87.Value
    Cells(linhavazia, 22).Value = TextBox88.Value
    Cells(linhavazia, 23).Value = TextBox89.Value
    Cells(linhavazia, 24).Value = TextBox90.Value
    Cells(linhavazia, 25).Value = TextBox91.Value
    Cells(linhavazia, 26).Value = TextBox92.Value
    Cells(linhavazia, 27).Value = TextBox93.Value
    Cells(linhavazia, 28).Value = TextBox94.Value
    pctCompl = 15
    C pctCompl

    Cells(linhavazia, 29).Value = TextBox95.Value
    Cells(linhavazia, 30).Value = TextBox96.Value
    Cells(linhavazia, 31).Value = TextBox97.Value
    Cells(linhavazia, 32).Value = TextBox98.Value
    Cells(linhavazia, 33).Value = TextBox99.Value
    Cells(linhavazia, 34).Value = TextBox100.Value
    Cells(linhavazia, 35).Value = TextBox101.Value
    Cells(linhavazia, 36).Value = TextBox102.Value
    Cells(linhavazia, 37).Value = TextBox103.Value
    pctCompl = 17
    C pctCompl

    Cells(linhavazia, 38).Value = TextBox104.Value
    Cells(linhavazia, 39).Value = TextBox105.Value
    Cells(linhavazia, 40).Value = TextBox106.Value
    Cells(linhavazia, 41).Value = TextBox107.Value
    Cells(linhavazia, 42).Value = TextBox108.Value
    Cells(linhavazia, 43).Value = TextBox109.Value
    Cells(linhavazia, 44).Value = TextBox110.Value
    Cells(linhavazia, 45).Value = TextBox111.Value
    Cells(linhavazia, 46).Value = TextBox112.Value
    pctCompl = 20
    C pctCompl

    Cells(linhavazia, 47).Value = TextBox113.Value
    Cells(linhavazia, 48).Value = TextBox114.Value
    Cells(linhavazia, 49).Value = TextBox115.Value
    Cells(linhavazia, 50).Value = TextBox116.Value
    Cells(linhavazia, 51).Value = TextBox117.Value
    Cells(linhavazia, 52).Value = TextBox118.Value
    Cells(linhavazia, 53).Value = TextBox119.Value
    Cells(linhavazia, 54).Value = TextBox120.Value
    Cells(linhavazia, 55).Value = TextBox121.Value
    pctCompl = 24
    C pctCompl

    Cells(linhavazia, 56).Value = TextBox122.Value
    Cells(linhavazia, 57).Value = TextBox123.Value
    Cells(linhavazia, 58).Value = TextBox124.Value
    Cells(linhavazia, 59).Value = TextBox125.Value
    Cells(linhavazia, 60).Value = TextBox126.Value
    Cells(linhavazia, 61).Value = TextBox127.Value
    Cells(linhavazia, 62).Value = TextBox128.Value
    Cells(linhavazia, 63).Value = TextBox129.Value
    Cells(linhavazia, 64).Value = TextBox130.Value
    pctCompl = 27
    C pctCompl


    Cells(linhavazia, 65).Value = TextBox131.Value
    Cells(linhavazia, 66).Value = TextBox132.Value



    'etapa a cada carrgamento da progressbar
    End If
    If TextBox190.Value = "" Then

    MsgBox ("CALCULE O TOTAL DE PARADAS!!"), vbCritical, "CRIARPLAN"

    ElseIf TextBox190.Value <> "" Then

    pctCompl = 30
    C pctCompl

    'PARTE DE PARADAS!

    Sheets("plan64").Select



    'ESSE COD VERIFICA SE PLAN2 ESTÁ SELECIONADA E AO MESMO TEMPO SELECIONA, CASO A PLANILHA NÃO SEJA SELECIONADA APARECE UMA MENSAGEM DE ERRO
    If Worksheets("PLAN64").Activate = True Then

    'Usaremos a propriedade ActiveSheet.Name para obtermos o nome da Aba ativa (worksheet).

    'MsgBox ActiveSheet.Name, vbInformation, ActiveWorkbook.Name
    pctCompl = 45
    W pctCompl

    Else
    MsgBox ("Erro ao selecionar planilha"), vbCritical
    Exit Sub
    End If










    linhavazia = WorksheetFunction.CountA(Range("A:A")) + 1

    Cells(linhavazia, 16).Value = TextBox177.Value
    Cells(linhavazia, 17).Value = TextBox178.Value
    Cells(linhavazia, 18).Value = TextBox179.Value
    Cells(linhavazia, 19).Value = TextBox180.Value
    Cells(linhavazia, 20).Value = TextBox181.Value
    Cells(linhavazia, 21).Value = TextBox182.Value
    Cells(linhavazia, 22).Value = TextBox183.Value
    Cells(linhavazia, 23).Value = TextBox184.Value
    Cells(linhavazia, 24).Value = TextBox185.Value
    Cells(linhavazia, 25).Value = TextBox186.Value
    Cells(linhavazia, 26).Value = TextBox187.Value
    Cells(linhavazia, 27).Value = TextBox188.Value
    Cells(linhavazia, 28).Value = TextBox189.Value

    Cells(linhavazia, 29).Value = TextBox191.Value



    pctCompl = 35
    C pctCompl





    Cells(linhavazia, 2).Value = ComboBox3.Value
    Cells(linhavazia, 3).Value = ComboBox4.Value
    Cells(linhavazia, 4).Value = ComboBox5.Value
    Cells(linhavazia, 5).Value = ComboBox6.Value
    Cells(linhavazia, 6).Value = ComboBox7.Value
    Cells(linhavazia, 7).Value = ComboBox8.Value
    Cells(linhavazia, 8).Value = ComboBox9.Value
    Cells(linhavazia, 9).Value = ComboBox10.Value
    Cells(linhavazia, 10).Value = ComboBox11.Value
    Cells(linhavazia, 11).Value = ComboBox12.Value
    Cells(linhavazia, 12).Value = ComboBox15.Value
    Cells(linhavazia, 13).Value = ComboBox14.Value
    Cells(linhavazia, 14).Value = ComboBox13.Value
    pctCompl = 40
    C pctCompl


    Cells(linhavazia, 1).Value = DTPicker1.Value
    'GRAVAR PARADAS"
    Cells(linhavazia, 15).Value = TextBox190.Value
    pctCompl = 44
    C pctCompl

    'QTD OCORRENCIAS
    Cells(linhavazia, 30).Value = ComboBox16.Value
    Cells(linhavazia, 31).Value = ComboBox17.Value
    Cells(linhavazia, 32).Value = ComboBox18.Value
    Cells(linhavazia, 33).Value = ComboBox19.Value
    Cells(linhavazia, 34).Value = ComboBox20.Value
    Cells(linhavazia, 35).Value = ComboBox21.Value
    Cells(linhavazia, 36).Value = ComboBox22.Value
    Cells(linhavazia, 37).Value = ComboBox23.Value
    Cells(linhavazia, 38).Value = ComboBox24.Value
    Cells(linhavazia, 39).Value = ComboBox25.Value
    Cells(linhavazia, 40).Value = ComboBox28.Value
    Cells(linhavazia, 41).Value = ComboBox27.Value
    Cells(linhavazia, 42).Value = ComboBox26.Value
    End If
    pctCompl = 48
    C pctCompl








    If TextBox64.Value = "" Then

    MsgBox ("INSIRA A PRODUÇÃO!"), vbCritical, "CRIARPLAN"

    ElseIf TextBox64.Value <> "" Then

    'PARTE DE PRODUÇÃO'
    Sheets("plan65").Select


    'ESSE COD VERIFICA SE PLAN2 ESTÁ SELECIONADA E AO MESMO TEMPO SELECIONA, CASO A PLANILHA NÃO SEJA SELECIONADA APARECE UMA MENSAGEM DE ERRO
    If Worksheets("PLAN65").Activate = True Then

    'Usaremos a propriedade ActiveSheet.Name para obtermos o nome da Aba ativa (worksheet).

    'MsgBox ActiveSheet.Name, vbInformation, ActiveWorkbook.Name
    pctCompl = 60
    W pctCompl

    Else
    MsgBox ("Erro ao selecionar planilha"), vbCritical
    Exit Sub
    End If







    linhavazia = WorksheetFunction.CountA(Range("A:A")) + 1

    Cells(linhavazia, 1).Value = DTPicker1.Value

    Cells(linhavazia, 2).Value = TextBox63.Value
    Cells(linhavazia, 3).Value = TextBox64.Value
    Cells(linhavazia, 4).Value = TextBox65.Value
    Cells(linhavazia, 5).Value = TextBox66.Value
    Cells(linhavazia, 6).Value = TextBox2.Value
    Cells(linhavazia, 7).Value = TextBox3.Value
    Cells(linhavazia, 8).Value = TextBox4.Value
    Cells(linhavazia, 9).Value = TextBox5.Value
    Cells(linhavazia, 10).Value = TextBox190.Value
    Cells(linhavazia, 11).Value = TextBox67.Value

    pctCompl = 50
    C pctCompl


    Sheets("plan89").Select





    'ESSE COD VERIFICA SE PLAN2 ESTÁ SELECIONADA E AO MESMO TEMPO SELECIONA, CASO A PLANILHA NÃO SEJA SELECIONADA APARECE UMA MENSAGEM DE ERRO
    If Worksheets("PLAN89").Activate = True Then

    'Usaremos a propriedade ActiveSheet.Name para obtermos o nome da Aba ativa (worksheet).

    'MsgBox ActiveSheet.Name, vbInformation, ActiveWorkbook.Name
    pctCompl = 75
    W pctCompl

    Else
    MsgBox ("Erro ao selecionar planilha"), vbCritical
    Exit Sub
    End If











    'PARTE DATA'
    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value

    linhavazia = WorksheetFunction.CountA(Range("B:B")) + 1
    Cells(linhavazia, 2).Value = MonthView2.Value
    pctCompl = 55
    C pctCompl





    'PARTE PROBLEMAS'



    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox3.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox4.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox5.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox6.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox7.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox8.Value
    'etapa a cada carrgamento da progressbar

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox9.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox10.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox11.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox12.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox15.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox14.Value

    linhavazia = WorksheetFunction.CountA(Range("c:c")) + 1
    Cells(linhavazia, 3).Value = ComboBox13.Value
    pctCompl = 60
    C pctCompl


    'etapa a cada carrgamento da progressbar


    'PARTE MIN'
    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox177.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox178.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox179.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox180.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox181.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox182.Value
    'etapa a cada carrgamento da progressbar

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox183.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox184.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox185.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox186.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox187.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox188.Value

    linhavazia = WorksheetFunction.CountA(Range("D:D")) + 1
    Cells(linhavazia, 4).Value = TextBox189.Value

    pctCompl = 65
    C pctCompl







    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox16.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox17.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox18.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox19.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox20.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox21.Value
    'etapa a cada carrgamento da progressbar

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox22.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox23.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox24.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox25.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox28.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox27.Value

    linhavazia = WorksheetFunction.CountA(Range("e:e")) + 1
    Cells(linhavazia, 5).Value = ComboBox26.Value

    pctCompl = 70
    C pctCompl



    'PARTE PLAN 72
    Sheets("plan72").Select


    'ESSE COD VERIFICA SE PLAN2 ESTÁ SELECIONADA E AO MESMO TEMPO SELECIONA, CASO A PLANILHA NÃO SEJA SELECIONADA APARECE UMA MENSAGEM DE ERRO
    If Worksheets("PLAN72").Activate = True Then

    'Usaremos a propriedade ActiveSheet.Name para obtermos o nome da Aba ativa (worksheet).

    'MsgBox ActiveSheet.Name, vbInformation, ActiveWorkbook.Name
    pctCompl = 100
    W pctCompl

    Else
    MsgBox ("Erro ao selecionar planilha"), vbCritical
    Exit Sub
    End If



    'conta quantas informações foram inseridas na coluna A da aba dados
    linhavazia = WorksheetFunction.CountA(Range("A:A")) + 1

    'Insere informações da aba dados

    Cells(linhavazia, 3).Value = TextBox201.Value
    Cells(linhavazia, 2).Value = TextBox202.Value
    Cells(linhavazia, 4).Value = TextBox3.Value
    Cells(linhavazia, 5).Value = TextBox4.Value
    Cells(linhavazia, 6).Value = TextBox206.Value
    Cells(linhavazia, 7).Value = TextBox64.Value
    Cells(linhavazia, 8).Value = TextBox203.Value
    Cells(linhavazia, 9).Value = TextBox204.Value
    Cells(linhavazia, 10).Value = TextBox190.Value
    Cells(linhavazia, 11).Value = TextBox67.Value
    Cells(linhavazia, 12).Value = TextBox208.Value

    Cells(linhavazia, 1).Value = DTPicker1.Value


    pctCompl = 75
    C pctCompl



    'CODIGO PDF
    Worksheets("plan67").Activate



    If MsgBox("Deseja gerar e arquivar o documento em PDF", vbQuestion + vbYesNo, "Confirmação") = vbYes Then

    pctCompl = 80
    C pctCompl


    With Plan67

    'Aqui o diretorio onde será salvo
    MyPath = "C:\BANCO DE DADOS AMORIM\CONTROLE DE EXTRUSÃO" 'Indica em que local a pasta estará , pode ser C: ou d: ou e:....
    'Aqui determina em qual pasta ira ser salvo o arquivo
    Pasta = ActiveSheet.Range("plan67").Value

    'tratamento de erro obs: a inputbox
    On Error GoTo aviso
    pctCompl = 85
    C pctCompl

    'Aqui determina o nome que o arquivo terá
    arquivo = TextBox209

    'Verifica se o diretorio e pasta especificados existe
    If (Dir(MyPath & "\" & Pasta, vbDirectory) = "") Then
    MsgBox "Diretório - " & MyPath & Pasta & " - Não encontrado"
    ' se não existir, cria se quiser
    MkDir (MyPath & Pasta)
    End If
    'Verifica se o arquivo já existe, se existir, deleta
    'If (Dir(Arquivo) <> "") Then
    ' Kill Arquivo
    'End If
    Sheets("plan67").Select
         
         
         Sheets("plan67").MonthView1.Value = Sheets("plan67").Range("b3")

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    MyPath & "\" & Pasta & "\" & arquivo, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False ' SE VÇ QUISER VER O PDF NA HORA BASTA COLOCAR O TRUE
    MsgBox ("Um documento foi gerado em pdf e arquivado com os dados do dia  " & [DTPicker1] & " "), vbInformation


    End With
    End If
    'FIM
     Dim salvar As Variant

    salvar = MsgBox("Deseja conferir as informações processadas?", vbYesNo + vbQuestion, "fechar a aplicação")
    If salvar = vbYes Then


       Sheets("PLAN40").Select
      ActiveWindow.SmallScroll down:=-12
      Range("C:E").Select

    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:="C:\temp.pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    pctCompl = 90
    C pctCompl



    Else
    End If



    'LIMPAR LISTVIW
    ListView1.ListItems.Clear
    ListView1.ColumnHeaders.Clear
    With ListView1
                .Gridlines = True
                .View = lvwReport
                .FullRowSelect = True
                .ColumnHeaders.Add Text:="DATA", Width:=60      'ID= Nome da 1ª coluna
                .ColumnHeaders.Add Text:="PRODUÇÃO", Width:=60, Alignment:=2   'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="AMP", Width:=55, Alignment:=2    'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="CORTE", Width:=40, Alignment:=2    'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="M/PROB", Width:=200, Alignment:=2    'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="PROD/HH", Width:=70, Alignment:=2    'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="RETRABALHO", Width:=70, Alignment:=2    'País=Nome da 2ª coluna
                           .ColumnHeaders.Add Text:="PARADOS", Width:=70, Alignment:=2    'País=Nome da 2ª coluna"
                           .ColumnHeaders.Add Text:="MIN/TRAB", Width:=50, Alignment:=2    'País=Nome da 2ª coluna
                          

        End With
    lastRow = Plan86.Cells(Rows.Count, "A").End(xlUp).Row
            'Adiciona itens
            For X = 2 To lastRow
                Set LI = ListView1.ListItems.Add(Text:=Plan86.Cells(X, "A").Value)
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "G").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "B").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "C").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "F").Value

         LI.ListSubItems.Add Text:=Plan86.Cells(X, "H").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "I").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "J").Value
     LI.ListSubItems.Add Text:=Plan86.Cells(X, "K").Value
               
     
        
        Next





    'CONTAVALORES
    Set intervalo = Worksheets("PLAN72").Range("A2:A1000")
    answer = WorksheetFunction.CountA(intervalo)
    Label75.Caption = answer & " Registros"
    'FIM
    pctCompl = 100
    C pctCompl


    MsgBox ("CADASTRO EFETUADO!"), vbInformation, "CRIARPLAN"

    pctCompl = 0
    C pctCompl

    pctCompl = 0
    W pctCompl


    Exit Sub
    aviso:



    End If


    Else
            MsgBox "CADASTRO CANCELADO", vbCritical
       
    End If
    End If




    • Editado Gênises sexta-feira, 11 de março de 2016 18:52
    sexta-feira, 11 de março de 2016 18:40
  • Pode usar o código abaixo para fazer backup:

    Sub CriarBackup()
        Dim BackupPath As String
        
        If MsgBox("Deseja salvar alterações", _
                  vbYesNo + vbQuestion, _
                  "Fechar a Aplicação") = vbYes Then
            ThisWorkbook.Save
        End If
        
        If MsgBox("Deseja realizar um backup? Criarplan desenvolvimento de sistemas com o excel e vba não se responsabiliza por perca de dados se não for realizado um backup?", _
                  vbYesNo + vbQuestion, _
                  "Fechar a Aplicação") = vbYes Then
            BackupPath = ThisWorkbook.Path & "\" & _
                         Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & " " & _
                         Format(Now, "yyyy-mm-dd hh.mm.ss") & ".xlsm"
            ThisWorkbook.SaveCopyAs BackupPath
            MsgBox "Backup Salvo!", vbInformation
        End If
    End Sub
    

    ---

    Cara, seu código está insustentável. Antes de mais nada, você precisa compilá-lo e acertar todos os erros.

    Também, verifique a indentação do código.

    Não se esqueça de utilizar as tags de código ao postar código aqui.

    Indente seu código e verifique se ele está compilando com sucesso.


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    • Marcado como Resposta Gênises sábado, 12 de março de 2016 12:03
    sexta-feira, 11 de março de 2016 19:45
    Moderador
  • Bom dia Felipe seu código ficou massa! Muito obrigado pela ajuda!

    Compilei meu código de cadastro e apresentou um erro, um evento estava sem um sub!

    Ao compilar em f8 um código de uma ListView que fica nos eventos inicialize e activate do userform de cadastro e em um CommandButton no mesmo userform teve um probleminha quando compilador chega na linha em que está next ele volta para o começo do código e começa de novo, o compiladpor fica indo e voltando! não sei se é por causa do laço de repetições! o interessante é que só acontece isso nos eventos inicialize e activate do userform, no CommandButton o compilador passa para as proximas linhas normalmente! será que é porque ao compilar esse código em um desses eventos isso acontece mesmo?

    With ListView1
                .Gridlines = True
                .View = lvwReport
                .FullRowSelect = True
                .ColumnHeaders.Add Text:="DATA", Width:=60      
                .ColumnHeaders.Add Text:="PRODUÇÃO", Width:=60, Alignment:=2   
                           .ColumnHeaders.Add Text:="AMP", Width:=55, Alignment:=2    
                           .ColumnHeaders.Add Text:="CORTE", Width:=40, Alignment:=2    
                           .ColumnHeaders.Add Text:="M/PROB", Width:=200, Alignment:=2    
                           .ColumnHeaders.Add Text:="PROD/HH", Width:=70, Alignment:=2    
                           .ColumnHeaders.Add Text:="RETRABALHO", Width:=70, Alignment:=2   
                           .ColumnHeaders.Add Text:="PARADOS", Width:=70, Alignment:=2   
                           .ColumnHeaders.Add Text:="MIN/TRAB", Width:=50, Alignment:=2   
                          
    
        End With
    lastRow = Plan86.Cells(Rows.Count, "A").End(xlUp).Row
            
            For X = 2 To lastRow
                Set LI = ListView1.ListItems.Add(Text:=Plan86.Cells(X, "A").Value)
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "G").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "B").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "C").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "F").Value
    
         LI.ListSubItems.Add Text:=Plan86.Cells(X, "H").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "I").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "J").Value
     LI.ListSubItems.Add Text:=Plan86.Cells(X, "K").Value
               
     
        
        Next






    • Editado Gênises sábado, 12 de março de 2016 12:19
    sábado, 12 de março de 2016 12:15
  • Gênises,

    Existe diferença entre compilar e depurar o código.

    Compilar com sucesso é quando você clica no menu Depurar-->Compilar.

    E depurar é pressionar F8 para executar o código passo a passo.

    Para uma boa organização, seu projeto deve compilar com sucesso.

    Em relação aos problemas que está tendo, pode ser que um evento esteja sendo chamado, mas preciso de mais detalhes.

    Quais são as linhas de código que o VBE fica alternando?


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    segunda-feira, 14 de março de 2016 17:46
    Moderador
  • Bom dia Felipe obrigado pela ajuda! ao depurar em f8 fica alternando entre "set LI" e "next"
    Set LI = ListView1.ListItems.Add(Text:=Plan86.Cells(X, "A").Value)
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "G").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "B").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "C").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "F").Value
    
         LI.ListSubItems.Add Text:=Plan86.Cells(X, "H").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "I").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "J").Value
     LI.ListSubItems.Add Text:=Plan86.Cells(X, "K").Value
               
     
        
        Next

    terça-feira, 15 de março de 2016 10:14
  • Onde inicia o laço? Isto é, onde está o For...To desse bloco de código?

    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    terça-feira, 15 de março de 2016 17:22
    Moderador
  • Bom dia! 
     For X = 2 To lastRow
                Set LI = ListView1.ListItems.Add(Text:=Plan86.Cells(X, "A").Value)
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "G").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "B").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "C").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "F").Value
    
         LI.ListSubItems.Add Text:=Plan86.Cells(X, "H").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "I").Value
                LI.ListSubItems.Add Text:=Plan86.Cells(X, "J").Value
     LI.ListSubItems.Add Text:=Plan86.Cells(X, "K").Value
               
     
        
        Next

    quarta-feira, 16 de março de 2016 12:07
  • Felipe por favor poderia dar uma olhada nesse código e dizer se tem algo errado com ele?
    Workbooks("tester.xlsm").Activate
    
    Dim COL As Variant, WOLD As Object
    
    
       Dim X As Date
       X = DTPicker1
     
    
    
    Dim CONFIRMAR As Variant
    
    CONFIRMAR = MsgBox("Deseja confirmar?", vbYesNo + vbQuestion, "SISTEMA EM VBA!")
    
    
    If CONFIRMAR = vbYes Then
    
    On Error GoTo trataErro
    
    Let COL = "A"
    If Len(COL) > 0 And Not COL Like "*[!0-9]*" Then COL = Val(COL)
    Set WOLD = DTPicker1
    With Columns(COL)
    
    Workbooks("tester.xlsm").Activate
    Sheets(1).Select
    
    
    
    .Replace WOLD, "#N/A", xlWhole
    
    
    
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Clear
    
    End With
    
    Exit Sub
    trataErro:
    MsgBox ("Ocorreu um erro em tempo de execução 1004 nenhuma célula foi encontrada!"), vbCritical
    
    
    
    Else
    End If
    

    quarta-feira, 16 de março de 2016 12:33
  • O seu código está desviando do Next para o Set porque isso é um laço. Laço são blocos de código que podem sofrer repetições: http://ambienteoffice.com.br/blog/sintaxe-do-vba/#lacos

    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quarta-feira, 16 de março de 2016 20:26
    Moderador
  • Sobre sua última postagem, não sei o que pretende fazer.

    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quarta-feira, 16 de março de 2016 20:27
    Moderador
  • Bom dia filipe! Poderia me dizer qual a diferença de text para value?
    If sheets("plan1").range("a1").text = "" Then
    If sheets("plan1").range("a1").value= "" Then



    sexta-feira, 18 de março de 2016 14:03
  • Text acessa o valor de exibição de uma célula, de acordo com as suas regras de formatação de exibição.

    Value acessa o valor real (interno) de uma célula.


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    segunda-feira, 21 de março de 2016 13:15
    Moderador
  • Obrigado!
    quarta-feira, 23 de março de 2016 11:35
  • Se não incomodar muito só mais uma pergunta! sabe algum link onde encontro imagens para botões no VBA?
    • Editado Gênises quarta-feira, 23 de março de 2016 11:37
    quarta-feira, 23 de março de 2016 11:36
  • Não sei informar.

    Gênises, favor abrir um tópico novo para cada pergunta.

    Vou bloquear este. Obrigado.


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quarta-feira, 23 de março de 2016 13:47
    Moderador