Remove From My Forums

Confirmar se dados de formulário foram entrados na planilha

Pergunta
0

Entrar para Votar
'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
- Editado Gênises sexta-feira, 11 de março de 2016 18:41
- Editado Felipe Costa GualbertoMVP, Moderator quinta-feira, 17 de março de 2016 00:55 Clareza
sexta-feira, 11 de março de 2016 10:14

Respostas

Entrar para Votar

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

0

Entrar para Votar

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
0

Entrar para Votar
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
0

Entrar para Votar

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
0

Entrar para Votar
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

Entrar para Votar

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

Entrar para Votar

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

1

Entrar para Votar

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

Entrar para Votar

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

0

Entrar para Votar

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

Entrar para Votar

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

Entrar para Votar

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

1

Entrar para Votar

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
0

Entrar para Votar

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
0

Entrar para Votar
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
1

Entrar para Votar

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
0

Entrar para Votar

Obrigado!

quarta-feira, 23 de março de 2016 11:35
0

Entrar para Votar
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
0

Entrar para Votar

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

Usuário com melhor resposta

Confirmar se dados de formulário foram entrados na planilha

Pergunta

Respostas

Todas as Respostas