Boa Tarde Pessoal!!
Estou mechendo em VBA a pouquíssimo tempo, porém já tenho um código bem definido que estou conseguindo rodar. Essa planilha tem um formulário com combobox (combobox combinada também tem) e textbox que vão para a planilha1 (esta parte está funcionando perfeitamente quem quiser pode copiar, inclusive com verificação de alguns campos).
Meu problema é o seguinte: Da planilha4 encaminha para um segundo arquivo "QNMGeral". Este QNMGeral está compartilhado e vai ficar aberto com um usuário quase que o tempo todo, as vezes o registro do formulário salva e as vezes não salva. Preciso de ajuda urgente!!!
Private Sub QualityNearMiss_Initialize()
End Sub
Private Sub cx_desvio_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Application.DisplayAlerts = False
Dim produto(60) As String
produto(0) = "Metragem linear"
produto(1) = "Diâmetro"
Dim atributos(19) As String
atributos(0) = "Alinhamento do Tubete"
atributos(1) = "Faceamento Lateral Irregular"
atributos(2) = "Faceamento Superfície Irregular"
If cx_desvio = Planilha2.Cells(2, 5) Then
cx_tipodesvio.List = produto()
ElseIf cx_desvio = Planilha2.Cells(3, 5) Then
cx_tipodesvio.List = atributos()
End If
Application.DisplayAlerts = True
End Sub
Private Sub Registrar_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim linha As String
linha = Sheets("Planilha1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
If ValidaCamposformulario = False Then
Exit Sub
End If
Planilha1.Cells(linha, 1) = cx_nome.List(cx_nome.ListIndex)
Planilha4.Cells(3, 1) = cx_nome.List(cx_nome.ListIndex)
Planilha1.Cells(linha, 4) = cx_deporigem.List(cx_deporigem.ListIndex)
Planilha4.Cells(3, 4) = cx_deporigem.List(cx_deporigem.ListIndex)
Planilha1.Cells(linha, 5).Value = text_data.Value
Planilha4.Cells(3, 5).Value = Me.text_data.Value
Planilha1.Cells(linha, 6) = cx_desvio.List(cx_desvio.ListIndex)
Planilha4.Cells(3, 6) = cx_desvio.List(cx_desvio.ListIndex)
Planilha1.Cells(linha, 7) = cx_tipodesvio.List(cx_tipodesvio.ListIndex)
Planilha4.Cells(3, 7) = cx_tipodesvio.List(cx_tipodesvio.ListIndex)
Planilha1.Cells(linha, 8) = cx_dep.List(cx_dep.ListIndex)
Planilha4.Cells(3, 8) = cx_dep.List(cx_dep.ListIndex)
Planilha1.Cells(linha, 9) = cx_area.List(cx_area.ListIndex)
Planilha4.Cells(3, 9) = cx_area.List(cx_area.ListIndex)
Planilha1.Cells(linha, 10).Value = text_desc.Value
Planilha4.Cells(3, 10).Value = text_desc.Value
Planilha1.Cells(linha, 15).Value = Me.text_acao.Value
Planilha4.Cells(3, 15).Value = text_acao.Value
Planilha1.Cells(linha, 11).Value = text_ftp.Value
Planilha1.Cells(linha, 12).Value = text_loteftp.Value
Planilha1.Cells(linha, 13).Value = text_mp.Value
Planilha1.Cells(linha, 14).Value = text_lotemp.Value
Planilha1.Cells(linha, 16).Value = text_os.Value
Planilha1.Cells(linha, 17).Value = text_causa.Value
Planilha1.Cells(linha, 2) = Now()
Planilha4.Cells(3, 11).Value = text_ftp.Value
Planilha4.Cells(3, 12).Value = text_loteftp.Value
Planilha4.Cells(3, 13).Value = text_mp.Value
Planilha4.Cells(3, 14).Value = text_lotemp.Value
Planilha4.Cells(3, 16).Value = text_os.Value
Planilha4.Cells(3, 17).Value = text_causa.Value
Planilha4.Cells(3, 2) = Now()
Call Copiardados
'limpando os campos do formulário
cx_nome.Value = Null
cx_deporigem.Value = Null
text_data.Value = Null
cx_desvio.Value = Null
cx_tipodesvio.Value = Null
cx_dep.Value = Null
cx_area.Value = Null
text_desc.Value = Null
text_ftp.Value = Null
text_loteftp.Value = Null
text_mp.Value = Null
text_lotemp.Value = Null
text_acao.Value = Null
text_os.Value = Null
text_causa.Value = Null
Unload Me
MsgBox "Registro feito com sucesso!!", vbInformation, "Sucesso"
ThisWorkbook.Save
ThisWorkbook.Close
ThisWorkbook.Application.Quit
Application.DisplayAlerts = True
End Sub
Private Sub Copiardados()
Dim QNM As Workbook
Dim QNMAba As Worksheet
Dim ultimalinha As String
Set QNM = Workbooks.Open("X:\Geral\· Qualidade Assegurada\9. QNM_Quality Near Miss\TESTE\QNMGERAL_2.xlsm")
Set QNMAba = QNM.Sheets("Planilha6")
ultimalinha = QNMAba.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
With QNMAba
ThisWorkbook.Sheets("Planilha4").Range("A3:Q3").Copy
QNMAba.Cells(ultimalinha, 2).PasteSpecial xlValues
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
End Sub
Private Function ValidaCamposformulario()
If cx_nome = "" Then
MsgBox "Informe o seu nome", vbInformation, "Erro"
cx_nome.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf cx_deporigem = "" Then
MsgBox "Informe sua área", vbInformation, "Erro"
cx_deporigem.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf text_data = "" Then
MsgBox "Informe a data da ocorrência", vbInformation, "Erro"
text_data.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf cx_desvio = "" Then
MsgBox "Informe o desvio encontrado", vbInformation, "Erro"
cx_desvio.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf cx_tipodesvio = "" Then
MsgBox "Informe o tipo de desvio encontrado", vbInformation, "Erro"
cx_tipodesvio.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf cx_dep = "" Then
MsgBox "Informe o departamento onde o incidente foi verificado", vbInformation, "Erro"
cx_dep.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf cx_area = "" Then
MsgBox "Informe a área onde o incidente foi verificado", vbInformation, "Erro"
cx_area.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf text_desc = "" Then
MsgBox "Informe a descrição do ocorrido", vbInformation, "Erro"
text_desc.SetFocus
ValidaCamposformulario = False
Exit Function
ElseIf text_acao = "" Then
MsgBox "Informe a ação imediata tomada por você", vbInformation, "Erro"
text_acao.SetFocus
ValidaCamposformulario = False
Exit Function
End If
ValidaCamposformulario = True
End Function
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Planilha Compartilhada
-
- Acabou de chegar
- Mensagens: 1
- Registrado em: Ter Jan 15, 2019 1:21 pm