CRYSTAL EXPORTAR PDF COM CÓDIGO DE BARRAS
Alterado em 22/05/2023 11:59:40
Eu não tenho nenhum problema com a exportação, vou colocar o trecho de como faço a exportação e o desenho do boleto que mais me deu trabalho para homologar, que é o Santander, onde tive que colocar 2 cod.barras sobrepostos no Crystal para dar o espaço correto de leitor deles e onde todos os leitores deram certo também
While Not RsEmpresasSelecionadas.EOF
If Trim(RsEmpresasSelecionadas!Email) <> "" Then
Set Rs = New ADODB.Recordset
Rs.Open StrSql & " where t.codtit = " & RsEmpresasSelecionadas!CodTit, Db, adOpenKeyset, adLockPessimistic
If Mid(CboBanco.Text, 1, 3) = "033" Then
Set RptBoletoSantander = New CrpBoletoSantander
RptBoletoSantander.DiscardSavedData
RptBoletoSantander.Database.SetDataSource RsDadosGuardados
RptBoletoSantander.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf
RptBoletoSantander.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD
RptBoletoSantander.ExportOptions.PDFExportAllPages = True 'Todas as páginas
RptBoletoSantander.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo
RptBoletoSantander.ExportOptions.DiskFileName = "Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
RptBoletoSantander.Export False ' o False é para evitar a exibição das caixas de diálogo.
Else
Set RptTitulo = New CrpTituloNovo
RptTitulo.DiscardSavedData
RptTitulo.Database.SetDataSource Rs
RptTitulo.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf
RptTitulo.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD
RptTitulo.ExportOptions.PDFExportAllPages = True 'Todas as páginas
RptTitulo.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo
RptTitulo.ExportOptions.DiskFileName = "Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
RptTitulo.Export False ' o False é para evitar a exibição das caixas de diálogo.
End If
End If
bSendFailed = False
If Trim(TxtTitulo.Text) = "" Then
TituloEmail = "Guia " & TipoBoleto & " - Empresa " & RsEmpresasSelecionadas!razaosocial & " - NossoNumero " & RsEmpresasSelecionadas!NossoNumero
Else
TituloEmail = TxtTitulo.Text
End If
EmailDestino = RsEmpresasSelecionadas!Email
CodigoEmpresa = RsEmpresasSelecionadas!CodEmpresa
With poSendMail
.SMTPHost = RsParametros!servidorsmtp
.SMTPPort = 587
.From = RsParametros!EnderecoEmail
.Attachment = App.Path & "\Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
.ConnectTimeout = 300 'Tempo
.Message = TxtMensagem.Text
If RsParametros!Autenticacao = 1 Then
bAuthLogin = True
.UseAuthentication = True
.Username = RsParametros!usuarioautenticacao
.Password = RsParametros!Senha
Else
bAuthLogin = False
End If
.Recipient = EmailDestino
.Subject = TituloEmail
.Send
End With
Kill App.Path & "\Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".*" 'O nome do arquivo pdf e excel
Else
If Trim(CodEmpresaSemEmail) = "" Then
CodEmpresaSemEmail = RsEmpresasSelecionadas!NossoNumero
Else
CodEmpresaSemEmail = CodEmpresaSemEmail & "," & RsEmpresasSelecionadas!NossoNumero
End If
End If
RsEmpresasSelecionadas.MoveNext
I = I + 1
ProgressBar1.Value = I
Wend
ProgressBar1.Visible = False
MsgBox "Envio concluído com sucesso"
Dessa forma envio para as empresas o boleto em pdf
** Não consegui anexar a imagem do cod.barras de como que ficou
Caso queira, me passa o seu email que tem passo a imagem
While Not RsEmpresasSelecionadas.EOF
If Trim(RsEmpresasSelecionadas!Email) <> "" Then
Set Rs = New ADODB.Recordset
Rs.Open StrSql & " where t.codtit = " & RsEmpresasSelecionadas!CodTit, Db, adOpenKeyset, adLockPessimistic
If Mid(CboBanco.Text, 1, 3) = "033" Then
Set RptBoletoSantander = New CrpBoletoSantander
RptBoletoSantander.DiscardSavedData
RptBoletoSantander.Database.SetDataSource RsDadosGuardados
RptBoletoSantander.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf
RptBoletoSantander.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD
RptBoletoSantander.ExportOptions.PDFExportAllPages = True 'Todas as páginas
RptBoletoSantander.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo
RptBoletoSantander.ExportOptions.DiskFileName = "Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
RptBoletoSantander.Export False ' o False é para evitar a exibição das caixas de diálogo.
Else
Set RptTitulo = New CrpTituloNovo
RptTitulo.DiscardSavedData
RptTitulo.Database.SetDataSource Rs
RptTitulo.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf
RptTitulo.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD
RptTitulo.ExportOptions.PDFExportAllPages = True 'Todas as páginas
RptTitulo.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo
RptTitulo.ExportOptions.DiskFileName = "Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
RptTitulo.Export False ' o False é para evitar a exibição das caixas de diálogo.
End If
End If
bSendFailed = False
If Trim(TxtTitulo.Text) = "" Then
TituloEmail = "Guia " & TipoBoleto & " - Empresa " & RsEmpresasSelecionadas!razaosocial & " - NossoNumero " & RsEmpresasSelecionadas!NossoNumero
Else
TituloEmail = TxtTitulo.Text
End If
EmailDestino = RsEmpresasSelecionadas!Email
CodigoEmpresa = RsEmpresasSelecionadas!CodEmpresa
With poSendMail
.SMTPHost = RsParametros!servidorsmtp
.SMTPPort = 587
.From = RsParametros!EnderecoEmail
.Attachment = App.Path & "\Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".pdf" 'O nome do arquivo
.ConnectTimeout = 300 'Tempo
.Message = TxtMensagem.Text
If RsParametros!Autenticacao = 1 Then
bAuthLogin = True
.UseAuthentication = True
.Username = RsParametros!usuarioautenticacao
.Password = RsParametros!Senha
Else
bAuthLogin = False
End If
.Recipient = EmailDestino
.Subject = TituloEmail
.Send
End With
Kill App.Path & "\Guia " & RsEmpresasSelecionadas!TipoBoleto & " " & RsEmpresasSelecionadas!NossoNumero & ".*" 'O nome do arquivo pdf e excel
Else
If Trim(CodEmpresaSemEmail) = "" Then
CodEmpresaSemEmail = RsEmpresasSelecionadas!NossoNumero
Else
CodEmpresaSemEmail = CodEmpresaSemEmail & "," & RsEmpresasSelecionadas!NossoNumero
End If
End If
RsEmpresasSelecionadas.MoveNext
I = I + 1
ProgressBar1.Value = I
Wend
ProgressBar1.Visible = False
MsgBox "Envio concluído com sucesso"
Dessa forma envio para as empresas o boleto em pdf
** Não consegui anexar a imagem do cod.barras de como que ficou
Caso queira, me passa o seu email que tem passo a imagem
Bem estranho, só se for algo com a dll do crystal para exportação. Gera tudo certinho, mas qdo exporto para pdf, seja pelo botão export do preview ou via código, igual o seu, ao invés da barra aparece os caracteres da imagem em anexo.
Anexo não esta subindo...
Da uma olhada no service pack do Crystal Reports 8.5 , eu baixei a muito tempo o service pack 7 más para o 9 , para corrigir algumas falhas nas Dlls
Eu ainda tenho o exe do meu service 9, se quiser tentar te mando no email
Eu ainda tenho o exe do meu service 9, se quiser tentar te mando no email
Então Alvaro, boa dica, mas eu acabei optando por fazer uma rotina de linha de comando pelo .net, assim passo a string do código de barras por parâmetro e gero a barra em png pelo .net, fica mais fácil para distribuir nos clientes. Agora se vc tiver o crystal 9 ai, e puder me enviar, me fala q te passo email. Vlw.
Mando sim, o meu email esta atualizado no meu cadastro, me manda um email que irei te responder
Abraço
Abraço
.
Tópico encerrado , respostas não são mais permitidas