Olá pessoal!

 

Tenho um Grid que tem colunas e linhas mescladas e não consigo imprimir os dados corretamente. Consegui em OCX que dizia imprimir os dados do Grid, mas as colunas e linhas mescladas ele repete voltando a separá-las.

 

Alguém já conseguiu fazer algo semelhante?

Achei isto na rede quase funciona be!!!!!!!!!!!!!!!!

 

 

Option Explicit

'declarações a api para exibir a caixa de dialog da impressora
Private Declare Function PrinterProperties Lib "winspool.drv" _
  (ByVal hwnd As Long, ByVal hPrinter As Long) As Long

Private Declare Function OpenPrinter Lib "winspool.drv" _
  Alias "OpenPrinterA" (ByVal pPrinterName As String, _
  phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long

Private Declare Function ClosePrinter Lib "winspool.drv" _
  (ByVal hPrinter As Long) As Long

Private Type PRINTER_DEFAULTS
   pDatatype As Long ' String
   pDevMode As Long
   pDesiredAccess As Long
End Type

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
   PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

Public OldColor As Long
Public OldWidth As Long

Public Function BoundedText(ByVal ptr As Object, ByVal txt As String, ByVal max_wid As Single) As String
    'Faz a string se ajustar a largura da celula
    Do While ptr.TextWidth(txt) > max_wid
        txt = Left$(txt, Len(txt) - 1)
    Loop
    BoundedText = txt
End Function

Public Sub ImprimeGrid(ByVal ptr As Object, ByVal flx As MSHFlexGrid, ByVal xmin As Single, ByVal ymin As Single)

On Error GoTo err_Visualiza

Const GAP = 60

Dim xmax As Single
Dim ymax As Single
Dim X As Single
Dim c As Integer
Dim r As Integer
Dim xTemp As Single
Dim yTemp As Single

With ptr.Font
  .Name = flx.Font.Name
  .Size = flx.Font.Size
End With

With flx
' verificar a largura.
xmax = xmin + GAP
For c = 0 To .Cols - 1
   xmax = xmax + .ColWidth(c) + 2 * GAP
Next c

' imprime cada linha
ptr.CurrentY = ymin

r = .SelectionMode
For r = 0 To .Rows - 1
 ' desenha uma linha acima desta linha.
   If r > 0 Then ptr.Line (xmin, ptr.CurrentY)-(xmax, ptr.CurrentY), , B
   ptr.CurrentY = ptr.CurrentY + GAP

  ' Imprime o conteudo da linha
  X = xmin + GAP
  For c = 0 To .Cols - 1
     ptr.CurrentX = X
    
'     If .TextMatrix(r, c) = "RESERVA" Or r = 1 Then
'            OldColor = ptr.ForeColor
'            OldWidth = ptr.DrawWidth
'            xTemp = X
'            yTemp = ptr.CurrentY
'            ptr.DrawWidth = 10
'            ptr.Line (X - .ColWidth(c) + 2 * GAP, ptr.CurrentY)-(X + .ColWidth(c) + 2 * GAP, ptr.CurrentY), &HC0C0C0
'            ptr.DrawWidth = OldWidth
'            ptr.ForeColor = OldColor
'            X = xTemp
'            ptr.CurrentY = yTemp
'     End If
    
     ptr.Print BoundedText(ptr, .TextMatrix(r, c), .ColWidth(c));
     X = X + .ColWidth(c) + 2 * GAP
  Next c
 
  ptr.CurrentY = ptr.CurrentY + GAP

  ' Vai para proxima linha
  ptr.Print
Next r
ymax = ptr.CurrentY

' desenha uma caixa
ptr.Line (xmin, ymin)-(xmax, ymax), , B

' Desenha linhas
  X = xmin
  For c = 0 To .Cols - 2
    X = X + .ColWidth(c) + 2 * GAP
    ptr.Line (X, ymin)-(X, ymax)
    ptr.Line (ymax, ymin)-(ymin, ymax)          'Imprime linha colunas
  Next c
End With
Exit Sub

err_Visualiza:
MsgBox "err: " & Err.Number & " Desc: " & Err.Description
End Sub

 

Valeu pela dica, vou tentar e ver o que acontece. Isso já me adiantou muito o que preciso fazer.