Visual Basic Forum

ander · Newbie Anmeldedatum: 15.09.2002 Beiträge: 1

Anfänger braucht Hilfe!
Ich möchte gerne den Inhalt eines datagrid ausdrucken.
Seit Tagen beschäftigt mich dieses Problem. Hat irgendjemand einen Tip für mich?
Besten Dank im voraus
Ander

_________________

StevieWWW · Newbie Anmeldedatum: 24.09.2002 Beiträge: 2

' Einzelne Zeile (alle Spalten) drucken
Private Sub PrintRow(ByVal xPos As Integer, _
ByVal fmt As String, ByVal sRow As String)
Dim OldScaleMode As Integer
Dim sColWidth() As String
Dim sColText() As String
Dim I As Integer

With Printer
OldScaleMode = .ScaleMode
.ScaleMode = 6 ' "mm"
sColWidth = Split(fmt, "|")
sColText = Split(sRow, "|")
If UBound(sColText) < UBound(sColWidth) Then _
ReDim Preserve sColText(UBound(sColWidth))
' alle Spalten drucken
For I = 0 To UBound(sColWidth)
.CurrentX = xPos
Printer.Print PrintCheckLength(sColText(I), _
sColWidth(I));
If IsNumeric(Left$(sColWidth(I), 1)) Then
xPos = xPos + Val(sColWidth(I))
Else
xPos = xPos + Val(Mid$(sColWidth(I), 2))
End If
Next I
Printer.Print
.ScaleMode = OldScaleMode
End With
End Sub

' Länge prüfen /Text ggf. abschneiden
Private Function PrintCheckLength(ByVal sText As String, _
ByVal sWidth As String) As String
Dim iLen As Integer
If Left$(sWidth, 1) = "^" Or Left$(sWidth, 1) = ">" Then
iLen = Val(Mid$(sWidth, 2))
Else
iLen = Val(sWidth)
End If
sText = RTrim$(sText)
With Printer
' wenn rechtsb., Platz für
' abschl.Leerzeichen lassen
' (als Trenner zum nachfolg.Text)
If Left$(sWidth, 1) = ">" Then _
iLen = iLen - .TextWidth(" ")
' wenn Text zu lang, kürzen
While .TextWidth(sText) > iLen
sText = Left$(sText, Len(sText) - 1)
Wend
If Left$(sWidth, 1) = "^" Then
' Text zentr.
While .TextWidth(sText) < iLen
sText = " " + sText + " "
Wend
ElseIf Left$(sWidth, 1) = ">" Then
' Text rechtsb.
While .TextWidth(sText) < iLen
sText = " " + sText
Wend
sText = sText + " "
End If
End With
PrintCheckLength = sText
End Function

Private Sub cmdPrint_Click()
Dim fmt As String
Dim sRow As String
Dim xPos As Long
Dim I As Long
Dim intProz As Integer
Dim GridWidth As Long
Dim ColWidth As Long
Dim PageWidth As Long
Dim sHeader As String
Screen.MousePointer = 11
With Printer
.Orientation = vbPRORLandscape
.ScaleMode = 6 ' "mm"
xPos = 10 ' 10mm links
.Font.Name = "Arial"
.Font.Size = 10
' Listentitel
.CurrentY = 10
.CurrentX = xPos
.Font.Bold = True
Printer.Print DataGrid1.Caption + vbCrLf
.Font.Bold = False
' Format (Spaltenbreiten) + Tabellenkopf
' anhand Bildschirm-Spaltenbr. erm.
PageWidth = .ScaleWidth - (xPos * 2)
With DataGrid1
' Gesamtbreite
For I = 0 To .Columns.Count - 1
If .Columns(I).Visible Then
GridWidth = GridWidth + .Columns(I).Width
End If
Next I
' Prozent. Verteilung auf Spalten
' plus Tabellenkopf
For I = 0 To .Columns.Count - 1
With .Columns(I)
' Spaltenausrichtung
Select Case .Alignment
Case dbgCenter
' zentriert
fmt = fmt & "^"
Case dbgRight
' rechtsbündig
fmt = fmt & ">"
End Select
' Spaltenbreite berechnen
intProz = (.Width / GridWidth * 100 + 0.5)
ColWidth = (PageWidth / 100 * intProz + 0.5)
fmt = fmt + Format$(ColWidth, "0")
' Tabellenkopf
sHeader = sHeader & .Caption
End With
fmt = fmt & "|"
sHeader = sHeader & "|"
Next I
' abschl. "|" entfernen
fmt = Left$(fmt, Len(fmt) - 1)
sHeader = Left$(sHeader, Len(sHeader) - 1)
End With
' Tabellenkopf drucken
.Font.Bold = True
.Font.Size = 9
PrintRow xPos, fmt, sHeader
.Font.Bold = False
' Recordset satzweise drucken
.Font.Size = 8
.CurrentY = .CurrentY + 5
rs.MoveFirst
While Not rs.EOF
sRow = ""
With DataGrid1
For I = 0 To .Columns.Count - 1
If .Columns(I).Visible Then
' NumberFormat berücksichtigen
If .Columns(I).NumberFormat <> "" Then
sRow = sRow + Format$(FeldInhalt(rs.Fields(I)), _
.Columns(I).NumberFormat) & "|"
Else
' normaler Text / sonstige Datentypen
sRow = sRow & CStr(FeldInhalt(rs.Fields(I))) & "|"
End If
End If
Next I
PrintRow xPos, fmt, sRow
End With
' nächster Datensatz
rs.MoveNext
Wend
' Druckauftrag beenden
.EndDoc
End With
Screen.MousePointer = 0
MsgBox "Grid wurde ausgedruckt!", 64, "Drucken..."
End Sub

' Nullfeld abfragen
Public Function FeldInhalt(Feld As Field) As Variant
If IsNull(Feld.Value) Then
Select Case Feld.Type
Case adInteger, adSmallInt, adDouble
FeldInhalt = 0
Case adBoolean
FeldInhalt = False
Case Else
FeldInhalt = ""
End Select
Else
FeldInhalt = Feld.Value
End If
End Function