3 DUVIDAS E UMA DICA LEGAL

 Tópico anterior Próximo tópico Novo tópico

3 DUVIDAS E UMA DICA LEGAL

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#1843 - 20/12/2003 19:14:38

GILMAR
BELO HORIZONTE
Cadast. em:Dezembro/2003


Eu tenho trs dvidas:

1)    no meu projeto eu tenho um campo OBSERVAES na qual coloco um texto mais longo. Este campo um TEXTBOX.  Acontece que quando eu mando imprimir, o texto sai numa linha contnua e no h quebra de linha. A formatao da linha tem de ser feito manualmente. Como contornar este inconveniente? (eu uso um documento do Word para impresso).
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:   Endereo ¢‚¬€œ Nmero. Eu consegui colocar um do lado do outro, mas no h espao entre um e outro. Como inserir um espao entre eles?
3)    Outra dvida em relao a um campo com mscara. Se a pessoa que preencher um formulrio deixar este campo em branco, abre uma caixa informando que no poder ficar em branco. Acontece que mesmo deixando o campo em branco a caixa no aparece ficando assim o campo sem preencher. Estou usando o comando assim:
    If MaskCEP.Mask = "" Then
                  MsgBox (" O CAMPO CEP NO PODE FICAR EM BRANCO"),                  
                   MaskCEP.SetFocus
                    Exit Sub
                    End If

A dica a seguinte: Alguns leitores tm escrito para saber com preencher uma COMBOBOX automaticamente. Eu peguei esta na internet (no me lembro onde) e funciona muito bem. A vai um exemplo: as caixas de combobox so: 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
---------------------------------------------------------------------------------------
Alm disto criar um CLASS MODULES e colocar o seguinte cdigo:

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




Resposta escolhida #1902 - 21/12/2003 03:18:52

USUARIO.EXCLUIDOS

Cadast. em:


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 impresso 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 paragrfo
    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 pargrafo
    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 pargrafo com uma nova linha em branco
  obj.Print
'Margem esquerda
  obj.CurrentX = Margem + 1 'Margem da linha seguinte
  Loop
End Sub

Sobre impresso 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 "Impresso enviada com sucesso!", vbInformation, Cabecalho
    pVarRegBanco.Close
    Set pVarRegBanco = Nothing

End Sub



 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por WEBMASTER em 18/08/2009 10:03:45