Notifications
Clear all

Gravando um dados através do formulario

3 Posts
2 Usuários
0 Reactions
868 Visualizações
(@edroger)
Posts: 6
Active Member
Topic starter
 

Boa noite!

Senhores tenho um planilha que gravo dados pelo formulário, ele verifica se já tem um arquivo gravado. Após o gravar ele vai identificar a qual grupo está associado e grava na planilha.

Mas ele esta gravando numa linha apos a linha do registro!

segue o código:

Sub GravRel()

'verifica se há dados duplicados

Dim i As Long 'Variável contadora
Dim ultimaLinha As Long 'variável para armazenar a última linha gravada na planilha
Dim RelDuplicado As Boolean 'Checar nome duplicado
Dim tNome, tMes, tAno As Integer

RelDuplicado = False

ThisWorkbook.Worksheets("BR").Activate

ultimaLinha = Sheets("BR").Cells(Cells.Rows.Count, 2).End(xlUp).Row

'Loop para varrer toda a planilha pela coluna

For i = 2 To ultimaLinha 'Faz o loop

tNome = Sheets("BR").Range("B" & i).Value
tMes = Sheets("BR").Range("C" & i).Value
tAno = Sheets("BR").Range("D" & i).Value

'Verifica se já possui registro

If tAno = ins_rel.listAno And tMes = ins_rel.listMes And tNome = ins_rel.listPublicador Then

MsgBox ("Esse Relatório já foi Feito!!")

RelDuplicado = True

Exit Sub

End If

Next

'Procura uma linha em Branco no Registro

Planilha5.Select
linha = 2
Do Until Sheets("BR").Cells(linha, 2) = ""
linha = linha + 1
Loop

'Verifica o publicador

If ins_rel.listPublicador = "" Then

MsgBox ("Selecione o Publicador!")

ins_rel.listPublicador.SetFocus

Exit Sub

End If

'Verifica o mes

If ins_rel.listMes = "" Then

MsgBox ("Selecione o Mês!")

ins_rel.listMes.SetFocus

Exit Sub

Else

End If

'Verifica o Ano

If ins_rel.listAno = "" Then

MsgBox ("Selecione o Ano!")

ins_rel.listAno.SetFocus

Exit Sub

Else

End If

'Verifica se é pioneiro Auxiliar

If ins_rel.chek_Pion_aux.Value = True Then

Sheets("BR").Cells(linha, 11) = "Pioneiro Auxiliar"

End If

'Verifica as horas

If ins_rel.txtHoras = "" Then

MsgBox ("Preencha as horas trabalhadas!")

ins_rel.txtHoras.SetFocus

Exit Sub

Else

End If

' verifica as Revisitas

If ins_rel.txtRevisitas < ins_rel.txtEstudos Then

MsgBox ("A qualtidade de Etudos não pode ser maior que o número de revisitias!")

ins_rel.txtRevisitas.SetFocus

Exit Sub

Else

End If

'Gravando o nome do Grupo no registro de relatório

Dim y, ultGrup As Long
Dim vGrup As Boolean

vGrup = False

ThisWorkbook.Worksheets("BD").Activate

ultGrupo = Sheets("BD").Cells(Cells.Rows.Count, 2).End(xlUp).Row

For y = 2 To ultGrupo 'Faz o loop

If Sheets("BD").Range("B" & y).Value = ins_rel.listPublicador Then

Sheets("BR").Range("E" & y).Value = Sheets("BD").Range("H" & y).Value

Sheets("BR").Range("G" & y).Value = Sheets("BD").Range("K" & y).Value

vGrup = True

End If

Next

'Grava dados
With Sheets("BR")

.Cells(linha, 2) = ins_rel.listPublicador
.Cells(linha, 3) = ins_rel.listMes
.Cells(linha, 4) = ins_rel.listAno
.Cells(linha, 6) = ins_rel.txtPub
.Cells(linha, 7) = ins_rel.txtVidMost
.Cells(linha, 8) = ins_rel.txtHoras
.Cells(linha, 9) = ins_rel.txtRevisitas
.Cells(linha, 10) = ins_rel.txtEstudos
.Cells(linha, 12) = Date

End With

MsgBox ("Relatório Gravado com Sucesso!")

 
Postado : 08/02/2017 5:11 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

.
Sua pergunta deveria ter sido feita em outro tópico .......... viewforum.php?f=10
.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 08/02/2017 5:57 pm
(@edroger)
Posts: 6
Active Member
Topic starter
 

ops!

 
Postado : 09/02/2017 4:20 pm