JUSTIFICAR TEXTO NA IMPRESSAO ?
TENHO ESSA ROTINA PARA JUSTIFICAR TEXTO NA IMPRESSÃO MAS O TEXTO NÃO FICA BEM JUSTIFICADO E PRECISO DEIXAR UMA LINHA ENTRE CADA LINHA IMPRESSA ALGUEM PODE ME AJUDAR ?
O TEXTO = [Ô]Atesto para os devidos fins TRABALHO que o SRº ANTONIO JOSé DOS SANTOS NETO portador do R.G. Nº 333.302.107 esteve em consulta no dia 23/09/2009 das 09:00 Hrs. à s 09:32 Hrs.Devendo permanecer em repouso durante : 03:00 horas.[Ô]
A FUNÇÃO PARA JUSTIFICAR :
Function WordWrap(ByVal Text As String, ByVal LineLength As Integer) As String
Dim look As String
Dim x As Long
Dim Y As Long
Dim eLine() As String
Dim tmp As String
eLine = Split(Text, vbCrLf)
If LineLength < 10 Then LineLength = 10
For Y = 0 To UBound(eLine)
Do While LineLength < Len(eLine(Y))
DoEvents
For x = LineLength To 1 Step -1
look = Mid(eLine(Y), x, 1)
Select Case look
Case [Ô] [Ô]
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & Trim(Left(eLine(Y), x))
eLine(Y) = Right(eLine(Y), Len(eLine(Y)) - x)
Exit For
Case Else
If x < (LineLength / 2) Then
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & Trim(Left(eLine(Y), LineLength - 1)) & [Ô]-[Ô]
eLine(Y) = Right(eLine(Y), Len(eLine(Y)) - (LineLength - 1))
Exit For
End If
End Select
Next x
Loop
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & eLine(Y)
Next Y
WordWrap = tmp
End Function
COMO O SPLIT NÃO FUNCIONOU NO MEU VB PEGUEI ESSA FUNÇÃO :
Function Split(ByVal Text As String, Optional ByVal Delimiter As String = [Ô] [Ô], _
Optional ByVal Limit As Long = -1, Optional CompareMethod As _
VbCompareMethod = vbBinaryCompare) As Variant
ReDim res(0 To 100) As String
Dim resCount As Long
Dim length As Long
Dim startIndex As Long
Dim endIndex As Long
length = Len(Text)
startIndex = 1
Do While startIndex <= length And resCount <> Limit
[ô] get the next delimiter
endIndex = InStr(startIndex, Text, Delimiter, CompareMethod)
If endIndex = 0 Then endIndex = length + 1
[ô] make room in the array, if necessary
If resCount > UBound(res) Then
ReDim Preserve res(0 To resCount + 99) As String
End If
[ô] store the new element
res(resCount) = Mid$(Text, startIndex, endIndex - startIndex)
resCount = resCount + 1
startIndex = endIndex + Len(Delimiter)
Loop
[ô] trim unused values
ReDim Preserve res(0 To resCount - 1) As String
[ô] return the array inside a Variant
Split = res()
End Function
OBRIGADO
O TEXTO = [Ô]Atesto para os devidos fins TRABALHO que o SRº ANTONIO JOSé DOS SANTOS NETO portador do R.G. Nº 333.302.107 esteve em consulta no dia 23/09/2009 das 09:00 Hrs. à s 09:32 Hrs.Devendo permanecer em repouso durante : 03:00 horas.[Ô]
A FUNÇÃO PARA JUSTIFICAR :
Function WordWrap(ByVal Text As String, ByVal LineLength As Integer) As String
Dim look As String
Dim x As Long
Dim Y As Long
Dim eLine() As String
Dim tmp As String
eLine = Split(Text, vbCrLf)
If LineLength < 10 Then LineLength = 10
For Y = 0 To UBound(eLine)
Do While LineLength < Len(eLine(Y))
DoEvents
For x = LineLength To 1 Step -1
look = Mid(eLine(Y), x, 1)
Select Case look
Case [Ô] [Ô]
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & Trim(Left(eLine(Y), x))
eLine(Y) = Right(eLine(Y), Len(eLine(Y)) - x)
Exit For
Case Else
If x < (LineLength / 2) Then
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & Trim(Left(eLine(Y), LineLength - 1)) & [Ô]-[Ô]
eLine(Y) = Right(eLine(Y), Len(eLine(Y)) - (LineLength - 1))
Exit For
End If
End Select
Next x
Loop
tmp = tmp & IIf(tmp > [Ô][Ô], vbCrLf, [Ô][Ô]) & eLine(Y)
Next Y
WordWrap = tmp
End Function
COMO O SPLIT NÃO FUNCIONOU NO MEU VB PEGUEI ESSA FUNÇÃO :
Function Split(ByVal Text As String, Optional ByVal Delimiter As String = [Ô] [Ô], _
Optional ByVal Limit As Long = -1, Optional CompareMethod As _
VbCompareMethod = vbBinaryCompare) As Variant
ReDim res(0 To 100) As String
Dim resCount As Long
Dim length As Long
Dim startIndex As Long
Dim endIndex As Long
length = Len(Text)
startIndex = 1
Do While startIndex <= length And resCount <> Limit
[ô] get the next delimiter
endIndex = InStr(startIndex, Text, Delimiter, CompareMethod)
If endIndex = 0 Then endIndex = length + 1
[ô] make room in the array, if necessary
If resCount > UBound(res) Then
ReDim Preserve res(0 To resCount + 99) As String
End If
[ô] store the new element
res(resCount) = Mid$(Text, startIndex, endIndex - startIndex)
resCount = resCount + 1
startIndex = endIndex + Len(Delimiter)
Loop
[ô] trim unused values
ReDim Preserve res(0 To resCount - 1) As String
[ô] return the array inside a Variant
Split = res()
End Function
OBRIGADO
ACHEI....
ESSA FUNÇÃO FUNCIONA PERFEITAMENTE.....
Option Explicit
Dim strPara As String[ô]String containing the Paragraph To be printed
Private Sub Form_Load()
strPara = [Ô]This is an example of how To print a paragraph that is left and right justified, just like a column of newsprint. xLeft contains the x position of the column start and xRight contains the x position of the column end. yStart contains the y position of the first line and ySpacing the amount of space you want between lines and is optional (250 is the default). Set all Printer.Font attributes before calling the PrintJustify subroutine. Play With the settings in Form_Load to fully test and check this code. As far as I could tell, there is nothing like this on PSC. Have Fun and please vote if you found this code informative and useful. Any comments would be appreciated.[Ô]
Printer.FontSize = 8
PrintJustify strPara, 700, 6000, 1000, 250
Printer.EndDoc
End
End Sub
Private Sub PrintJustify(ByVal strText As String, xLeft As Integer, xRight As Integer, yStart As Integer, Optional ySpacing As Integer)
Dim aWords() As String [ô]Array containing all the words in strText
Dim iWords As Integer[ô]The Number of words that will be printed in the current iLine
Dim iWidth As Integer[ô]The available space For a line To print in
Dim iLine As Integer[ô]The current line To be printed
Dim xSpace As Integer[ô]The amount of Space between Each word To be printed
Dim xPrint As Integer[ô]The x position that the Next word will be printed in
Dim yPrint As Integer[ô]The y position that the Next word will be printed in
Dim strWords As String [ô]A string containing the words of the line To be printed
Dim i As Integer[ô]For/Next counter Variable
Dim j As Integer[ô]For/Next counter Variable
[ô]Replace any CRLF with space
strText = Replace(strText, vbCrLf, [Ô] [Ô])
[ô]Replace any [Ô] [Ô] with [Ô] [Ô]
strText = Replace(strText, [Ô] [Ô], [Ô] [Ô])
[ô]Remove any before or after spaces
strText = Trim(strText)
[ô]Initialize Line Counter
iLine = 0
[ô]Set ySpacing Default
If ySpacing = 0 Then
ySpacing = 250
End If
[ô]Calculate Width of Print Column
iWidth = xRight - xLeft
[ô]Keep Processing until all lines have be
[ô] en printed
Do Until strText = [Ô][Ô]
[ô]Increment Line Counter
iLine = iLine + 1
[ô]Calculate yPrint
yPrint = yStart + ((iLine - 1) * ySpacing)
[ô]Break strText into pieces
Erase aWords
aWords = Split(strText, [Ô] [Ô])
[ô]Determine How many words can fit in lin
[ô] e
strWords = [Ô][Ô]
For i = 0 To UBound(aWords)
If i = 0 Then
strWords = aWords(0)
Else
strWords = strWords & [Ô] [Ô] & aWords(i)
End If
If Printer.TextWidth(strWords) > iWidth Then
iWords = i - 1 [ô]last word becomes first word of Next line
Exit For
End If
Next i
[ô]Rewrite StrText if Words are still left
[ô]
strText = [Ô][Ô]
If iWords < UBound(aWords) Then
For i = iWords + 1 To UBound(aWords)
If i = iWords + 1 Then
strText = aWords(i)
Else
strText = strText & [Ô] [Ô] & aWords(i)
End If
Next i
Else [ô]Print Last Line With No Justification
Printer.CurrentX = xLeft
Printer.CurrentY = yPrint
Printer.Print strWords
Exit Sub
End If
[ô]Now we can Print Justified Line
[ô]Get Width of all Words to be Printed (N
[ô] o Spaces)
strWords = [Ô][Ô]
For i = 0 To iWords
strWords = strWords & aWords(i)
Next i
[ô]Get Width of Blank Space
xSpace = iWidth - Printer.TextWidth(strWords)
[ô]Calculate Blank Space Between Words
xSpace = Int(xSpace / iWords)
[ô]Print Last Word Right Justified
Printer.CurrentX = xRight - Printer.TextWidth(aWords(iWords))
Printer.CurrentY = yPrint
Printer.Print aWords(iWords)
[ô]Print Words xSpace apart
For i = 0 To iWords - 1 [ô]We just printed the last word
[ô]Calculate xPrint
xPrint = xLeft
For j = 1 To i
xPrint = xPrint + Printer.TextWidth(aWords(j - 1)) + xSpace
Next j
Printer.CurrentX = xPrint
Printer.CurrentY = yPrint
Printer.Print aWords(i)
Next i
Loop
End Sub
ESSA FUNÇÃO FUNCIONA PERFEITAMENTE.....
Option Explicit
Dim strPara As String[ô]String containing the Paragraph To be printed
Private Sub Form_Load()
strPara = [Ô]This is an example of how To print a paragraph that is left and right justified, just like a column of newsprint. xLeft contains the x position of the column start and xRight contains the x position of the column end. yStart contains the y position of the first line and ySpacing the amount of space you want between lines and is optional (250 is the default). Set all Printer.Font attributes before calling the PrintJustify subroutine. Play With the settings in Form_Load to fully test and check this code. As far as I could tell, there is nothing like this on PSC. Have Fun and please vote if you found this code informative and useful. Any comments would be appreciated.[Ô]
Printer.FontSize = 8
PrintJustify strPara, 700, 6000, 1000, 250
Printer.EndDoc
End
End Sub
Private Sub PrintJustify(ByVal strText As String, xLeft As Integer, xRight As Integer, yStart As Integer, Optional ySpacing As Integer)
Dim aWords() As String [ô]Array containing all the words in strText
Dim iWords As Integer[ô]The Number of words that will be printed in the current iLine
Dim iWidth As Integer[ô]The available space For a line To print in
Dim iLine As Integer[ô]The current line To be printed
Dim xSpace As Integer[ô]The amount of Space between Each word To be printed
Dim xPrint As Integer[ô]The x position that the Next word will be printed in
Dim yPrint As Integer[ô]The y position that the Next word will be printed in
Dim strWords As String [ô]A string containing the words of the line To be printed
Dim i As Integer[ô]For/Next counter Variable
Dim j As Integer[ô]For/Next counter Variable
[ô]Replace any CRLF with space
strText = Replace(strText, vbCrLf, [Ô] [Ô])
[ô]Replace any [Ô] [Ô] with [Ô] [Ô]
strText = Replace(strText, [Ô] [Ô], [Ô] [Ô])
[ô]Remove any before or after spaces
strText = Trim(strText)
[ô]Initialize Line Counter
iLine = 0
[ô]Set ySpacing Default
If ySpacing = 0 Then
ySpacing = 250
End If
[ô]Calculate Width of Print Column
iWidth = xRight - xLeft
[ô]Keep Processing until all lines have be
[ô] en printed
Do Until strText = [Ô][Ô]
[ô]Increment Line Counter
iLine = iLine + 1
[ô]Calculate yPrint
yPrint = yStart + ((iLine - 1) * ySpacing)
[ô]Break strText into pieces
Erase aWords
aWords = Split(strText, [Ô] [Ô])
[ô]Determine How many words can fit in lin
[ô] e
strWords = [Ô][Ô]
For i = 0 To UBound(aWords)
If i = 0 Then
strWords = aWords(0)
Else
strWords = strWords & [Ô] [Ô] & aWords(i)
End If
If Printer.TextWidth(strWords) > iWidth Then
iWords = i - 1 [ô]last word becomes first word of Next line
Exit For
End If
Next i
[ô]Rewrite StrText if Words are still left
[ô]
strText = [Ô][Ô]
If iWords < UBound(aWords) Then
For i = iWords + 1 To UBound(aWords)
If i = iWords + 1 Then
strText = aWords(i)
Else
strText = strText & [Ô] [Ô] & aWords(i)
End If
Next i
Else [ô]Print Last Line With No Justification
Printer.CurrentX = xLeft
Printer.CurrentY = yPrint
Printer.Print strWords
Exit Sub
End If
[ô]Now we can Print Justified Line
[ô]Get Width of all Words to be Printed (N
[ô] o Spaces)
strWords = [Ô][Ô]
For i = 0 To iWords
strWords = strWords & aWords(i)
Next i
[ô]Get Width of Blank Space
xSpace = iWidth - Printer.TextWidth(strWords)
[ô]Calculate Blank Space Between Words
xSpace = Int(xSpace / iWords)
[ô]Print Last Word Right Justified
Printer.CurrentX = xRight - Printer.TextWidth(aWords(iWords))
Printer.CurrentY = yPrint
Printer.Print aWords(iWords)
[ô]Print Words xSpace apart
For i = 0 To iWords - 1 [ô]We just printed the last word
[ô]Calculate xPrint
xPrint = xLeft
For j = 1 To i
xPrint = xPrint + Printer.TextWidth(aWords(j - 1)) + xSpace
Next j
Printer.CurrentX = xPrint
Printer.CurrentY = yPrint
Printer.Print aWords(i)
Next i
Loop
End Sub
Tópico encerrado , respostas não são mais permitidas