MUDAR DE LINHA AUTOMATICAMENTE NO PDF

SMZTODOPODEROSO 04/01/2025 07:26:54
#503737

Alterado em 04/01/2025 07:30:16 Descrição sumaria
Tenho o seguinte código que gera um pdf
Ele está a funcionar sem nenhum erro. Alguém me consegue informar como dou um parágrafo ao ler a minha text1.text.
Ou seja no código “.DrawText 1, i, Text1.Text, "Fnt1", 10, pdfAlignLeft” ele escreve no pdf tudo na mesma linha sem dar o parágrafo, nem mudar de linha automaticamente
Alguém me consegue ajudar

Dim i As Single
datahoraactual = "Relatório visualizado em : " & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "HH:MM")
Dim dblElapsed As Double

dblElapsed = Timer
lblEnd.Caption = ""

Dim clPDF As New clsPDFCreator
Dim strFile As String

strFile = App.Path & "elatorio.pdf"

With clPDF
.Title = "Escola Rosa e Sousa"
.ScaleMode = pdfCentimeter
.PaperSize = pdfA4
.Margin = 0
.Orientation = pdfPortrait
.EncodeASCII85 = (chkASCII85.Value = Checked)
.InitPDFFile strFile
' **************************************** Defenição do tipo de letras
.LoadFont "Fnt1", "Times New Roman"
.LoadFont "Fnt2", "Times New Roman", pdfBold
.LoadFont "Fnt3", "Times New Roman", pdfItalic
.LoadFont "Fnt4", "Times New Roman", pdfBoldItalic
.LoadFontStandard "Fnt4", "Times New Roman", pdfBoldItalic
' **************************************** Carregamento das imagens
.LoadImgFromBMPFile "Img1", App.Path & "\foto1.bmp"
.LoadImgFromBMPFile "Img2", App.Path & "\foto2.bmp"

.StartObject "Item1", pdfAllPages '
.SetColorFill -240
.SetTextHorizontalScaling 120
.DrawText 2.5, 1, "Escola Rosa e Sousa", "Fnt2", 80, , 60
.SetColorFill 0
.EndObject
Dim nomerelatorio As String
' Inicia a pagina
.BeginPage

.DrawText 19.2, 1.5, "Página " & Trim(CStr(.Pages)), "Fnt1", 10, pdfAlignRight
.DrawText 2, 1.5, Format(Date, "YYYY-MM-DD"), "Fnt1", 10, pdfAlignLeft
.DrawObject "Footers"
.DrawImg "Img1", 2, 29, 3, 3
.DrawImg "Img2", 16.5, 29, 3, 3
.DrawText 10.5, 28.3, "MINISTÉRIO DA EDUCAÇÃO", "Fnt1", 7, pdfCenter
.DrawText 10.5, 27.8, "DREC", "Fnt2", 10, pdfCenter
.DrawText 10.5, 27.3, "AGRUPAMENTO DE ESCOLAS CENTRO INTERIOR", "Fnt2", 10, pdfCenter
.DrawText 10.5, 26.8, "ESCOLA ROSA E SOUSA", "Fnt2", 10, pdfCenter
.DrawText 10.5, 26, "Relatório de intercâmbio", "Fnt2", 12, pdfCenter

i = 25
.DrawText 1, i, "Descrição sumaria", "Fnt2", 10, pdfAlignLeft
i = i - 0.5
.DrawText 1, i, Text1.Text, "Fnt1", 10, pdfAlignLeft

.EndPage
' ************************************** Total de paginas
.StartObject "Footers", pdfAllPages
.DrawText 20, 1.5, "de " & Trim(CStr(.Pages)), "Fnt1", 10, pdfAlignRight
.EndObject
.ClosePDFFile
End With
dblElapsed = Timer - dblElapsed
lblEnd.Caption = Format(dblElapsed, "0.00")
Call Shell("rundll32.exe url.dll,FileProtocolHandler " & (strFile), vbMaximizedFocus)

Print da text1
https://www.imghippo.com/i/LKqi8107sw.JPG

FABRICIOWEB 04/01/2025 16:11:06
#503738 Resposta escolhida

Segue uma solução para ajustar o texto e implementar a quebra automática de linhas:

Function WordWrapText(ByVal text As String, ByVal maxWidth As Single, ByVal fontSize As Single, ByVal fontName As String, ByRef pdf As clsPDFCreator) As Collection
Dim lines As New Collection
Dim words() As String
Dim currentLine As String
Dim testWidth As Single
Dim i As Integer

words = Split(text, " ")
currentLine = ""

For i = LBound(words) To UBound(words)
If currentLine = "" Then
currentLine = words(i)
Else
' Testa se a próxima palavra cabe na linha
testWidth = pdf.MeasureTextWidth(currentLine & " " & words(i), fontName, fontSize)
If testWidth <= maxWidth Then
currentLine = currentLine & " " & words(i)
Else
lines.Add currentLine
currentLine = words(i)
End If
End If
Next i

' Adiciona a última linha
If currentLine <> "" Then
lines.Add currentLine
End If

Set WordWrapText = lines
End Function

Sub GeneratePDF()
Dim i As Single
Dim lines As Collection
Dim line As Variant

' Código para iniciar o PDF
' ...

i = 25
.DrawText 1, i, "Descrição sumaria", "Fnt2", 10, pdfAlignLeft
i = i - 0.5

' Quebra o texto em várias linhas
Set lines = WordWrapText(Text1.Text, 18, 10, "Fnt1", clPDF) ' Ajuste maxWidth conforme necessário

' Escreve cada linha no PDF
For Each line In lines
.DrawText 1, i, line, "Fnt1", 10, pdfAlignLeft
i = i - 0.5 ' Ajuste o espaçamento entre as linhas
Next line

.EndPage

' Código para fechar o PDF
' ...
End Sub

Para usar a função WordWrapText no seu código antigo sem reestruturar todo o código, você pode integrá-la diretamente onde o texto é escrito no PDF

Dim i As Single
datahoraactual = "Relatório visualizado em : " & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "HH:MM")
Dim dblElapsed As Double

dblElapsed = Timer
lblEnd.Caption = ""

Dim clPDF As New clsPDFCreator
Dim strFile As String

strFile = App.Path & "elatorio.pdf"

With clPDF
.Title = "Escola Rosa e Sousa"
.ScaleMode = pdfCentimeter
.PaperSize = pdfA4
.Margin = 0
.Orientation = pdfPortrait
.EncodeASCII85 = (chkASCII85.Value = Checked)
.InitPDFFile strFile

' **************************************** Defenição do tipo de letras
.LoadFont "Fnt1", "Times New Roman"
.LoadFont "Fnt2", "Times New Roman", pdfBold
.LoadFont "Fnt3", "Times New Roman", pdfItalic
.LoadFont "Fnt4", "Times New Roman", pdfBoldItalic
.LoadFontStandard "Fnt4", "Times New Roman", pdfBoldItalic

' **************************************** Carregamento das imagens
.LoadImgFromBMPFile "Img1", App.Path & "\foto1.bmp"
.LoadImgFromBMPFile "Img2", App.Path & "\foto2.bmp"

.StartObject "Item1", pdfAllPages '
.SetColorFill -240
.SetTextHorizontalScaling 120
.DrawText 2.5, 1, "Escola Rosa e Sousa", "Fnt2", 80, , 60
.SetColorFill 0
.EndObject

Dim nomerelatorio As String
.BeginPage

.DrawText 19.2, 1.5, "Página " & Trim(CStr(.Pages)), "Fnt1", 10, pdfAlignRight
.DrawText 2, 1.5, Format(Date, "YYYY-MM-DD"), "Fnt1", 10, pdfAlignLeft
.DrawObject "Footers"
.DrawImg "Img1", 2, 29, 3, 3
.DrawImg "Img2", 16.5, 29, 3, 3
.DrawText 10.5, 28.3, "MINISTÉRIO DA EDUCAÇÃO", "Fnt1", 7, pdfCenter
.DrawText 10.5, 27.8, "DREC", "Fnt2", 10, pdfCenter
.DrawText 10.5, 27.3, "AGRUPAMENTO DE ESCOLAS CENTRO INTERIOR", "Fnt2", 10, pdfCenter
.DrawText 10.5, 26.8, "ESCOLA ROSA E SOUSA", "Fnt2", 10, pdfCenter
.DrawText 10.5, 26, "Relatório de intercâmbio", "Fnt2", 12, pdfCenter

i = 25
.DrawText 1, i, "Descrição sumaria", "Fnt2", 10, pdfAlignLeft
i = i - 0.5

' Adiciona lógica para quebrar o texto em linhas
Dim lines As Collection
Dim line As Variant

' Chama a função para dividir o texto
Set lines = WordWrapText(Text1.Text, 18, 10, "Fnt1", clPDF) ' Ajuste maxWidth conforme necessário

' Escreve cada linha no PDF
For Each line In lines
.DrawText 1, i, line, "Fnt1", 10, pdfAlignLeft
i = i - 0.5 ' Ajuste o espaçamento entre as linhas
Next line

.EndPage

.StartObject "Footers", pdfAllPages
.DrawText 20, 1.5, "de " & Trim(CStr(.Pages)), "Fnt1", 10, pdfAlignRight
.EndObject
.ClosePDFFile
End With

dblElapsed = Timer - dblElapsed
lblEnd.Caption = Format(dblElapsed, "0.00")
Call Shell("rundll32.exe url.dll,FileProtocolHandler " & (strFile), vbMaximizedFocus)

SMZTODOPODEROSO 04/01/2025 17:36:08
#503739

Não consegui implementar essa sugestão, deixo o link com o código fonte para ser mais fácil a interpretação

https://www.zipshare.com/download/eyJhcmNoaXZlSWQiOiI4ODRhYTMwNi00OWVkLTQwNWUtOGVjOC1lZjBkOWQ2MzI2ZWYiLCJlbWFpbCI6InNtenRvZG9wb2Rlcm9zb0BnbWFpbC5jb20ifQ==

JOSE 05/01/2025 00:19:27
#503740

Ola,
Ao ver seu questionamento tive a ideia de cortar linha a linha do arquivo texto, fiz isso, coloquei em um listbox (invisivel), poderia ser uma variavel.
Estou enviando o arquivo comprimido em anexo.

SMZTODOPODEROSO 05/01/2025 19:16:48
#503741

Citação:
Ola,Ao ver seu questionamento tive a ideia de cortar linha a linha do arquivo texto, fiz isso, coloquei em um listbox (invisivel), poderia ser uma variavel.Estou enviando o arquivo comprimido em anexo.

Foi uma boa ideia, sempre que encontra parágrafo ele faz, só que agora deparo-me com outro problema nos textos mais compridos e sem parágrafos ele não faz a mudança de linha. Não existe uma função para justificar o texto num determinado espaço? Sempre que chegasse ali mudava de linha como funciona no word

JOSE 06/01/2025 19:49:54
#503742

Realizei testes para tentar simular o problema:

Tentei simular um texto com paragrafo gigante e passou normalmente (540 palavras).

Tentei simular um texto com linha gigante e nao passou (145 caracteres)! Essa linha gigante tera que ser quebrada.

Todos os testes que fiz foi colando o texto na caixa de texto e clicando no botao gerar (obs. antes de colar o texto executava do zero o .exe).

Favor, poste um arquivo zip com um texto que voce esta tendo problemas para simular aqui.

FABRICIOWEB 07/01/2025 14:04:06
#503743

Melhor que isso so dois disso
finalize o tópico se for isso, código alterado para reconhecer parágrafos e quebrar linha por quantidade de caracteres configuravel

FABRICIOWEB 07/01/2025 14:07:50
#503745

resultado

JOSE 07/01/2025 14:32:45
#503746

FABRICIOWEB, muito bom resultado. Vamos aguardar a resposta do interessado principal SMZTODOPODEROSO.

SMZTODOPODEROSO 08/01/2025 11:44:41
#503747

Boas desculpem não responder mais depresssa, estive doente :-(

Envio o print https://www.imghippo.com/i/kw6897YgE.JPG do que esta acontecendo aqui

Aqui o programa https://www.zipshare.com/download/eyJhcmNoaXZlSWQiOiJkNDc2OTU3ZC01MThkLTRjYjgtYjQ4OS05ODdjYWI2ZTAwYTAiLCJlbWFpbCI6InNtenRvZG9wb2Rlcm9zb0BnbWFpbC5jb20ifQ==

FABRICIOWEB 08/01/2025 12:13:20
#503748

cara vc nem chegou a usar o arquivo que eu enviei

Página 1 de 2 [13 registro(s)]

Tópico encerrado , respostas não são mais permitidas

Voltar