3 DUVIDAS E UMA DICA LEGAL

GILMAR 20/12/2003 19:14:38
#1843
Eu tenho três dúvidas:

1) no meu projeto eu tenho um campo OBSERVAÇÕES na qual coloco um texto mais longo. Este campo é um TEXTBOX. Acontece que quando eu mando imprimir, o texto sai numa linha contínua e não há quebra de linha. A formatação da linha tem de ser feito manualmente. Como contornar este inconveniente? (eu uso um documento do Word para impressão).
2) No site do Macoratti tem um artigo que mostra como imprimir etiquetas e está funcionando normalmente. Só que eu preciso colocar um campo do lado do outro, por exemplo: Endereço – Número. Eu consegui colocar um do lado do outro, mas não há espaço entre um e outro. Como inserir um espaço entre eles?
3) Outra dúvida é em relação a um campo com máscara. Se a pessoa que preencher um formulário deixar este campo em branco, abre uma caixa informando que não poderá ficar em branco. Acontece que mesmo deixando o campo em branco a caixa não aparece ficando assim o campo sem preencher. Estou usando o comando assim:
If MaskCEP.Mask = "" Then
MsgBox (" O CAMPO CEP NÃO PODE FICAR EM BRANCO"),
MaskCEP.SetFocus
Exit Sub
End If

A dica é a seguinte: Alguns leitores têm escrito para saber com preencher uma COMBOBOX automaticamente. Eu peguei esta na internet (não me lembro onde) e funciona muito bem. Aí vai um exemplo: as caixas de combobox são: cboEstado, cboEstadoCivil e cboSexo.


---------------------------------------------------------------------------
Option Explicit
Private moCombo As cComboHelper
---------------------------------------------------------------------------

Private Sub Form_Load()
On Error Resume Next
With cboSexo
.AddItem "FEMININO"
.AddItem "MASCULINO"
End With
With cboEstado
.AddItem "AC"
.AddItem "AL"
.AddItem "AM"
.AddItem "AP"
.AddItem "BA"
.AddItem "CE"
.AddItem "DF"
.AddItem "ES"
.AddItem "GO"
.AddItem "MA"
.AddItem "MG"
.AddItem "MS"
.AddItem "MT"
.AddItem "PA"
.AddItem "PB"
.AddItem "PE"
.AddItem "PI"
.AddItem "PR"
.AddItem "RJ"
.AddItem "RN"
.AddItem "RO"
.AddItem "RR"
.AddItem "RS"
.AddItem "SC"
.AddItem "SE"
.AddItem "SP"
.AddItem "TO"
End With
With cboEstadoCivil
.AddItem "CASADO(a)"
.AddItem "DESQUITADO(a)"
.AddItem "DIVORCIADO(a)"
.AddItem "SOLTEIRO(a)"
.AddItem "VIÃÅ¡VO(a)"
End With
Set moCombo = New cComboHelper
End Sub
------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Set moCombo = Nothing
End Sub
---------------------------------------------------------------------------------------
Além disto criar um CLASS MODULES e colocar o seguinte código:

Option Explicit
Private WithEvents moCombo As ComboBox
Private Declare Function SendMessageByString Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
Private Const CB_SETCURSEL = &H14E
Private Const CB_FINDSTRING = &H14C
Private Const CB_FINDSTRINGEXACT = &H158
-------------------------------------------------------------------------------------------
Private Function MatchingRow(ByVal sText$, ByVal mStart&, ByVal iMatchType%) As Long
Dim mFoundRow As Long
On Error GoTo Err_MatchingRow
mFoundRow = SendMessageByString(moCombo.hWnd, iMatchType, mStart, sText)
Bye_MatchingRow:
MatchingRow = mFoundRow
Exit Function
Err_MatchingRow:
mFoundRow = -1
Resume Bye_MatchingRow
End Function
-------------------------------------------------------------------------------
Public Sub AttachTo(ByVal oCombo As ComboBox)
On Error Resume Next
Set moCombo = oCombo
End Sub

Private Sub Class_Terminate()
On Error Resume Next
Set moCombo = Nothing
End Sub
-------------------------------------------------------------------------------
Public Function Contains(ByVal sText$) As Boolean

On Error Resume Next
Contains = (SendMessageByString(moCombo.hWnd, CB_FINDSTRINGEXACT, 0, sText) -1)
End Function
-------------------------------------------------------------------------------
Private Function ResultingText(iKeyAscii%) As String
Dim sLeft As String
Dim sSel As String
Dim sRight As String
Dim sResult As String
On Error Resume Next
With moCombo
sLeft = Left$(.Text, .SelStart)
sSel = Mid$(.Text, .SelStart + 1, .SelLength)
sRight = Mid$(.Text, .SelStart + .SelLength + 1)
End With
Select Case iKeyAscii
Case vbKeyBack
If Len(sSel) = 0 Then
sResult = MinusRightChar(sLeft) & sRight
Else
sResult = sLeft & sRight
End If
Case vbKeyDelete
If Len(sSel) = 0 Then
sResult = sLeft & MinusLeftChar(sRight)
Else
sResult = sLeft & sRight
End If
Case Else
sResult = sLeft & Chr$(iKeyAscii) & sRight
End Select
Bye_ResultingText:
ResultingText = sResult
End Function
-------------------------------------------------------------------------------------------------------
Private Function MinusLeftChar(ByVal sGiven As String) As String
On Error Resume Next
If Len(sGiven) = 0 Then
MinusLeftChar = ""
Else
MinusLeftChar = Mid$(sGiven, 2)
End If
End Function
-----------------------------------------------------------------------------------------------
Private Function MinusRightChar(ByVal sGiven As String) As String
On Error Resume Next
If Len(sGiven) = 0 Then
MinusRightChar = ""
Else
MinusRightChar = Left$(sGiven, Len(sGiven) - 1)
End If
End Function
------------------------------------------------------------------------------------------------
Private Sub moCombo_KeyDown(KeyCode As Integer, Shift As Integer)
Dim sSearchOn As String
On Error Resume Next
If KeyCode vbKeyDelete Then GoTo Bye_moCombo_KeyDown
sSearchOn = ResultingText(KeyCode)
If SearchOn(sSearchOn, CB_FINDSTRINGEXACT) = True Then KeyCode = 0
Bye_moCombo_KeyDown:
Exit Sub
End Sub
-------------------------------------------------------------------------------------------------
Private Sub moCombo_KeyPress(KeyAscii As Integer)
Dim sSearchOn As String
On Error Resume Next
If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyTab Then
GoTo Bye_moCombo_KeyPress
End If
sSearchOn = ResultingText(KeyAscii)
If KeyAscii = vbKeyBack Then
If SearchOn(sSearchOn, CB_FINDSTRINGEXACT) = True Then KeyAscii = 0
Else
If SearchOn(sSearchOn, CB_FINDSTRING) = True Then KeyAscii = 0
End If
Bye_moCombo_KeyPress:
Exit Sub
End Sub
------------------------------------------------------------------------------------------------------
Private Function SearchOn(ByVal sStartText$, ByVal iMatchType%) As Boolean
Dim mOriginalIndex As Long
Dim mNewIndex As Long
Dim yMoveOccurred As Boolean
On Error Resume Next
mOriginalIndex = moCombo.ListIndex
yMoveOccurred = False
mOriginalIndex = mOriginalIndex - 1
If mOriginalIndex -1 Then mOriginalIndex = -1
With moCombo
If Len(sStartText) 0 Then
mNewIndex = MatchingRow(sStartText, mOriginalIndex, iMatchType)
If mNewIndex -1 Then
SendMessageByString .hWnd, CB_SETCURSEL, mNewIndex, 0
.SelStart = Len(sStartText)
.SelLength = Len(.Text) - Len(sStartText)
yMoveOccurred = True
End If
Else
SendMessageByString .hWnd, CB_SETCURSEL, -1, 0
If mOriginalIndex -1 Then yMoveOccurred = True
End If
End With
SearchOn = yMoveOccurred
End Function
[S25]
USUARIO.EXCLUIDOS 21/12/2003 03:18:52
#1902
Resposta escolhida
Sobre a quebra de paragrafo:
Public Sub Paragrafo(obj As Object, ByVal txt As String, Optional Margem As Byte)
'Rotina que imprime textos com paragrafo
'Recebe o Texto a ser impresso
'Retorno:executa impressão com quebra de linha

Static Pos As Integer
Static Para As String
Static Word As String

'Margem esquerda
If Not IsNumeric(Margem) Then Margem = 1


obj.CurrentX = Margem + 1 'Margem da primeira linha

'Inicia impressao do arquivo texto
Do While Len(txt) 0

'Pega o proximo paragráfo
Pos = InStr(txt, vbCrLf)

If Pos = 0 Then
Para = txt
txt = ""
Else: Para = Left$(txt, Pos - 1)
txt = Mid$(txt, Pos + 2)
End If

'Imprime o parágrafo
Do While Len(Para) 0
'Pega a proxima palavra.
Pos = InStr(Para, " ")
If Pos = 0 Then
Word = Para
Para = ""
Else
Word = Left$(Para, Pos)
Para = Mid$(Para, Pos + 1)
End If

'Imprime a palavra
If (obj.CurrentX + obj.TextWidth(Word)) = (obj.ScaleWidth - 0.5) Then
'Ve se a palavra se adequa a pagina
obj.Print Word;

Else
'Inicia nova linha
obj.Print
obj.CurrentX = Margem + 1 'Margem da linha seguinte
obj.Print Word;
End If

Loop
'Finaliza o parágrafo com uma nova linha em branco
obj.Print
'Margem esquerda
obj.CurrentX = Margem + 1 'Margem da linha seguinte
Loop
End Sub

Sobre impressão de etiquetas

Public Sub Imp_Etiquetas(Query As String)
Const Coluna1 As Long = 1.2
Const Coluna2 As Long = 11
On Error Resume Next

If Not ConsultaSQL(Query) Then
Printer.EndDoc
Exit Sub
End If

Printer.ScaleMode = 7
Printer.FontName = "ARIAL"

pVarRegBanco.MoveFirst
Printer.CurrentY = MargSuperior + 1

Do While Not (pVarRegBanco.EOF)

Printer.FontSize = 7

'Nome da primeira coluna
Printer.CurrentX = Coluna1
Printer.Print Spc(1); pVarRegBanco(0); Spc(1); pVarRegBanco("nome");

'Nome da segunda coluna
pVarRegBanco.MoveNext
Printer.CurrentX = Coluna2
If Not IsNumeric(pVarRegBanco(0)) Then Printer.Print Spc(1); " "; Spc(1); " "
Printer.Print Spc(1); pVarRegBanco(0); Spc(1); pVarRegBanco("nome")

'End numero da primeira coluna
pVarRegBanco.MovePrevious
Printer.CurrentX = Coluna1
Printer.Print Spc(1); pVarRegBanco("Endereco"); Spc(2); pVarRegBanco("numero");

'End numero da segunda coluna
pVarRegBanco.MoveNext
Printer.CurrentX = Coluna2
If Not IsNumeric(pVarRegBanco(0)) Then Printer.Print Spc(1); " "; Spc(4); " "
Printer.Print Spc(1); pVarRegBanco("Endereco"); Spc(2); pVarRegBanco("numero")

'Complemento bairro primeira coluna
pVarRegBanco.MovePrevious
Printer.CurrentX = Coluna1
Printer.Print Spc(1); pVarRegBanco("complemento"); Spc(2); pVarRegBanco("bairro");

'Complemento bairro segunda coluna
pVarRegBanco.MoveNext
Printer.CurrentX = Coluna2
If Not IsNumeric(pVarRegBanco(0)) Then Printer.Print Spc(1); " "; Spc(4); " "
Printer.Print Spc(1); pVarRegBanco("complemento"); Spc(2); pVarRegBanco("bairro")

'Cidade Estado primeira coluna
pVarRegBanco.MovePrevious
Printer.CurrentX = Coluna1
Printer.Print Spc(1); pVarRegBanco("cidade"); Spc(3); pVarRegBanco("estado");

'Cidade Estado segunda coluna
pVarRegBanco.MoveNext
Printer.CurrentX = Coluna2
If Not IsNumeric(pVarRegBanco(0)) Then Printer.Print Spc(1); " "; Spc(4); " "
Printer.Print Spc(1); pVarRegBanco("cidade"); Spc(3); pVarRegBanco("estado")

'Cep primeira coluna
pVarRegBanco.MovePrevious
Printer.CurrentX = Coluna1
Printer.Print Spc(1); pVarRegBanco("cep");

'Cep segunda coluna
pVarRegBanco.MoveNext
Printer.CurrentX = Coluna2
If Not IsNumeric(pVarRegBanco(0)) Then Printer.Print Spc(1); " "; Spc(4); " "
Printer.Print Spc(1); pVarRegBanco("cep")

Printer.Print
Printer.Print

pVarRegBanco.MoveNext

Loop

Printer.EndDoc
MsgBox "Impressão enviada com sucesso!", vbInformation, Cabecalho
pVarRegBanco.Close
Set pVarRegBanco = Nothing

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