Ich habe jetz den Code für die Druckfunktion geschrieben. Ich bekomm aber das Kommentarfeld von der Zelle K nicht in die Druckvorlage in Zelle A13 per. VBA übertragen.
Hat jemand ein Tipp?
Option Explicit
Private Sub UserForm_Activate()
Dim lIndx As Long
Dim lAnzahl As Long
Dim WbSh As Worksheet
Set WbSh = Worksheets("Wartung")
lAnzahl = IIf(WbSh.Range("A65536") <> "", 65536, WbSh.Range("A65536").End(xlUp).Row)
Application.ScreenUpdating = False ' kein Bildschirm Update
UserForm1.Label1.Caption = "Bitte die gewünschte Adresse auswählen."
With UserForm1.ListBox1
.ColumnCount = 8 ' ListBox auf 8 Spalten bringen
.ColumnWidths = _
"5,0 cm; 5,0 cm; 5,0 cm; 5,0 cm; 5,0 cm" ' die Spalten-Breiten
End With
For lIndx = 6 To lAnzahl ' sortiertes Resultat sichtbar machen
UserForm1.ListBox1.AddItem " "
UserForm1.ListBox1.List(lIndx - 6, 0) = WbSh.Range("F" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 1) = WbSh.Range("I" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 2) = WbSh.Range("J" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 3) = WbSh.Range("G" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 4) = WbSh.Range("H" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 5) = WbSh.Range("D" & lIndx).Value
UserForm1.ListBox1.List(lIndx - 6, 6) = WbSh.Range("K" & lIndx).Value
Next lIndx
Application.ScreenUpdating = True ' Bildschirm Update zulassen
End Sub
Private Sub ListBox1_Click()
Dim Antwort As Integer
With Sheets("Auftrag")
Range("B4").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 0)
Range("B5").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 1)
Range("B6").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 2)
Range("B7").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 3)
Range("B8").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 4)
Range("B9").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 5)
Range("B10").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 6)
Range("B11").Value = UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 7)
End With
Antwort = MsgBox("soll der Wartungsauftrag für " & _
UserForm1.ListBox1.List(Me.ListBox1.ListIndex, 0) & _
" wirklich gedruckt werden?", vbYesNo)
If Antwort = vbYes Then
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Unload UserForm1
End Sub
|