- 10 Jun 2020 às 23:32
#55830
Boa noite, não entendo nada de VBA porém peguei um arquivo pra ajudar um amigo que entende menos ainda, minha área é outra...
o arquivo em questão é uma planilha com várias linhas contendo dados de salário de quase 200 funcionários, cada linha uma pessoa. nessa planilha tem um botão que quando eu clico gera um relatório onde cada página gera um relatório de um funcionário, porém de repente parou de funcionar exibindo o erro acima. Pesquisei bastante, encontrei topicos falando pra declarar uma variável, tópico pra habilitar uma biblioteca no excel, atualizar vb, nada funcionou. Então como os tópicos relacionados são antigos decidi abrir outro pois nada do que vi funcionou para este arquivo em questão, não posso enviar a planilha por conter dados pessoais de funcionários porém vou enviar como a planilha está, e o código completo da geração do relatório.
Na tentativa de declarar a variável em questão que aparece na depuração, independente do tipo que informo, o erro muda para 91 e continua sem funcionar, e neste ponto não sei mais como prosseguir, ou mesmo sei se é por ai a solução. Espero que possam ajudar, é um documento importante para as atividades realizadas na empresa. Desde já agradeço a compreensão.
A planilha tem o seguinte formato:
Informações Banco de horas Comissão Bônus Extras Descontos
Nome Frente Taxa Produtividade BH Valor Valor Valor Acréscimos Valor a Pagar
1 fulano Operação R$ 64,48 160,00 160,00 0 R$ - R$ - R$ - R$ - R$ -
2 Ciclano Operação R$ 2.000 0,75 0,75 0 R$ - R$ - R$ - R$ - R$ -
A imagem mostra a página do relatorio
abaixo o codigo vba. O erro se da na função Sub GeraRelatorio(), ao que parece na variavel relatorio, na linha Set wsPdf = relatorio
https://transferxl.com/06bp7wGgc4hM
o arquivo em questão é uma planilha com várias linhas contendo dados de salário de quase 200 funcionários, cada linha uma pessoa. nessa planilha tem um botão que quando eu clico gera um relatório onde cada página gera um relatório de um funcionário, porém de repente parou de funcionar exibindo o erro acima. Pesquisei bastante, encontrei topicos falando pra declarar uma variável, tópico pra habilitar uma biblioteca no excel, atualizar vb, nada funcionou. Então como os tópicos relacionados são antigos decidi abrir outro pois nada do que vi funcionou para este arquivo em questão, não posso enviar a planilha por conter dados pessoais de funcionários porém vou enviar como a planilha está, e o código completo da geração do relatório.
Na tentativa de declarar a variável em questão que aparece na depuração, independente do tipo que informo, o erro muda para 91 e continua sem funcionar, e neste ponto não sei mais como prosseguir, ou mesmo sei se é por ai a solução. Espero que possam ajudar, é um documento importante para as atividades realizadas na empresa. Desde já agradeço a compreensão.
A planilha tem o seguinte formato:
Informações Banco de horas Comissão Bônus Extras Descontos
Nome Frente Taxa Produtividade BH Valor Valor Valor Acréscimos Valor a Pagar
1 fulano Operação R$ 64,48 160,00 160,00 0 R$ - R$ - R$ - R$ - R$ -
2 Ciclano Operação R$ 2.000 0,75 0,75 0 R$ - R$ - R$ - R$ - R$ -
A imagem mostra a página do relatorio
abaixo o codigo vba. O erro se da na função Sub GeraRelatorio(), ao que parece na variavel relatorio, na linha Set wsPdf = relatorio
Código: Selecionar todos
PS: Enviei o arquivo porem retirei o nome e logo da empresa, bem como os nomes dos funcionários, então talvez tenha perdido alguma referencia na tabela dinamicaOption Explicit
'Option Private Module
Sub QuebraDeLinha(irow As Integer)
ActiveSheet.Rows(irow).PageBreak = xlPageBreakManual
End Sub
Sub testeImprimir()
Dim i As Integer
For i = 5 To 25 Step 5
QuebraDeLinha (i)
Next
ImprimeRelatorio ("Relatorio")
End Sub
Private Sub ImprimeRelatorio(aba As String)
Dim vbSimNao As Integer
Dim ultLin As Integer
Dim myMesExp As String
Dim myAnoExp As String
Dim myDataExp As String
Dim acompanhamentoPDF As String
vbSimNao = 4
vbSimNao = MsgBox("Deseja exportar o 'Relatório de Acompanhamento'?", vbYesNo, "Exportar Relatório")
'se resposta for sim, ele exclui, sai e desmarca
If vbSimNao = 6 Then
'Call MyDesbloqueio
Sheets(aba).Visible = True
ultLin = Sheets(aba).Range("B65000").End(xlUp).Row + 1 'Application.WorksheetFunction.CountA(Sheets(aba).Range("B:B"))
myMesExp = Format(Month(Date), "0") 'STRING
myAnoExp = Format(Year(Date), "0000") 'STRING
myDataExp = myMesExp & "_" & myAnoExp 'STRING
acompanhamentoPDF = ThisWorkbook.Path & "\Relatorio de Acompanhamento_" & myDataExp & ".pdf"
Sheets(aba).Range("A1:F" & ultLin).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=acompanhamentoPDF
Sheets(aba).Visible = xlSheetVeryHidden
ActiveWorkbook.Save
MsgBox ("O 'Relatório de Acompanhamento' foi exportado para a pasta (" & ThisWorkbook.Path & ")."), _
vbInformation, "Status da Exportação"
openFolder (ThisWorkbook.Path)
'Call MyBloqueio
Else
MsgBox "Impressão cancelada pelo usuário!!", vbInformation
Exit Sub
End If
End Sub
Sub openFolder(folder As String)
Dim Foldername As String
Foldername = folder
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbMaximizedFocus 'vbNormalFocus
End Sub
Sub GeraRelatorio()
Dim lista As Range
Dim ws As Worksheet
Dim wsReport As Worksheet
Dim wsPdf As Worksheet
Dim uLin As Integer
Dim i As Integer
Dim c As Integer
Dim lMerge1 As Integer
Dim lMerge2 As Integer
Dim lMerge3 As Integer
Dim lMerge4 As Integer
Dim lImagem As Integer
Dim shape As shape
lMerge1 = 13
lMerge2 = 15
lMerge3 = 37
lMerge4 = 27
lImagem = 2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
'Atribui a ws a planilha resumo
Set ws = resumo
'Atribui a wsReport a planilha resumo
Set wsReport = report
'Atribui a wsReport a planilha resumo
Set wsPdf = relatorio
wsPdf.Visible = xlSheetVisible
'Ultima Linha (Nomes)
uLin = ws.Range("b65000").End(xlUp).Row
Set lista = ws.Range("B10:B" & uLin)
'limpa wsPdf
wsPdf.Activate
wsPdf.Cells.ClearContents
wsPdf.Cells.ClearFormats
' Remove as logos do arquivo de relatório
For Each shape In wsPdf.Shapes
shape.Delete
Next
'unmerge - desmesclar
wsReport.Range("B13:E13").UnMerge
wsReport.Range("B15:E15").UnMerge
wsReport.Range("B37:E37").UnMerge
wsReport.Range("D27:E27").UnMerge
'Largura da Coluna
wsPdf.Range("A1:F65000").Rows.AutoFit
c = 1
wsPdf.Columns(c).ColumnWidth = 1.57: c = c + 1
wsPdf.Columns(c).ColumnWidth = 20.29: c = c + 1
wsPdf.Columns(c).ColumnWidth = 20.29: c = c + 1
wsPdf.Columns(c).ColumnWidth = 20.29: c = c + 1
wsPdf.Columns(c).ColumnWidth = 20.29: c = c + 1
wsPdf.Columns(c).ColumnWidth = 1.57: c = c + 1
wsPdf.Cells.PageBreak = xlPageBreakNone
For i = 1 To lista.Count
'Debug.Print lista(i).Value
If lista(i).Value <> "" Then
wsReport.Cells(8, 3) = lista(i).Value
If wsReport.Range("D27").Value2 > 0 Then
wsReport.Range("A1:F44").Copy
wsPdf.Select
uLin = wsPdf.Range("B65000").End(xlUp).Row + 1
If uLin = 2 Then uLin = 1
wsPdf.Range("A" & uLin).PasteSpecial xlPasteFormats
wsPdf.Range("A" & uLin).PasteSpecial xlPasteValues
'wsPdf.Range("A" & uLin).PasteSpecial xlPasteAll
'Copia a Logo da ITSS
wsReport.Shapes("logo").Copy
' Posiciona a logo
wsPdf.Paste wsPdf.Range("E" & lImagem): lImagem = lImagem + 37
'Mesclar
wsPdf.Range("B" & lMerge1 & ":E" & lMerge1).Merge '13
wsPdf.Range("B" & lMerge2 & ":E" & lMerge2).Merge '15
wsPdf.Range("B" & lMerge3 & ":E" & lMerge3).Merge '37
wsPdf.Range("D" & lMerge4 & ":E" & lMerge4).Merge '27
wsPdf.Range("D" & lMerge4 & ":E" & lMerge4).HorizontalAlignment = xlCenter
wsPdf.Rows(lMerge1).RowHeight = 52.5: wsPdf.Rows(lMerge2).AutoFit: wsPdf.Rows(lMerge3).RowHeight = 70.5
lMerge1 = lMerge1 + 37: lMerge2 = lMerge2 + 37: lMerge3 = lMerge3 + 37: lMerge4 = lMerge4 + 37
uLin = wsPdf.Range("B65000").End(xlUp).Row + 1
QuebraDeLinha (uLin)
End If
End If
'copiar para a aba nova
Next
'Mesclar
wsReport.Range("B13:E13").Merge
wsReport.Range("B15:E15").Merge
wsReport.Range("B37:E37").Merge
wsReport.Range("D27:E27").Merge
ImprimeRelatorio ("Relatorio")
uLin = wsPdf.Range("B65000").End(xlUp).Row + 1
wsPdf.PageSetup.PrintArea = "$A$1:$F$" & uLin
wsReport.Activate
wsPdf.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
https://transferxl.com/06bp7wGgc4hM
