Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Planilha Compartilhada

Dúvidas gerais sobre Excel
GrazielaFrazato
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Ter Jan 15, 2019 1:21 pm

Planilha Compartilhada

Mensagem por GrazielaFrazato »

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


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder