メインフォームコード
'下のコードを追加してください
'抽出結果印刷
Private Sub ExFillterPrintPreview()
Dim lrow As Long
Dim i As Long
'マウスポインターを砂時計に
Application.Cursor = xlWait
DoEvents
'印刷シートをクリア
lrow = Sheets("印刷").Range("A65536").End(xlUp).Row
Sheets("印刷").Range("A1:L" & lrow).Delete
lrow = Sheets("抽出").Range("A65536").End(xlUp).Row
'別シートへコピー
Worksheets("抽出").Range("A4:H" & lrow).Copy Destination:=Worksheets("印刷").Range("A1")
lrow = Sheets("印刷").Range("A65536").End(xlUp).Row
'印刷範囲
Sheets("印刷").PageSetup.PrintArea = "A1:H" & lrow
'用紙サイズ
Sheets("印刷").PageSetup.PaperSize = xlPaperA4
'用紙方向
Sheets("印刷").PageSetup.Orientation = xlLandscape
'余白 センチをポイントに変換しセット
Sheets("印刷").PageSetup.LeftMargin = Application.CentimetersToPoints(1)
Sheets("印刷").PageSetup.RightMargin = Application.CentimetersToPoints(0.6)
Sheets("印刷").PageSetup.TopMargin = Application.CentimetersToPoints(1.8)
Sheets("印刷").PageSetup.BottomMargin = Application.CentimetersToPoints(1.1)
Sheets("印刷").PageSetup.HeaderMargin = Application.CentimetersToPoints(1)
Sheets("印刷").PageSetup.FooterMargin = Application.CentimetersToPoints(0.7)
'マウスポインターを戻す
Application.Cursor = xlNormal
'印刷プレビュー
Sheets("印刷").PrintPreview
End Sub
下記のコードに変更してください
'抽出ボタン
Private Sub CommandButton7_Click()
Dim srow As String
Dim tRange As Range
Frm抽出.Show
If EditRecordNo > 0 Then
'1行目から検索
Set tRange = Sheets("T取引先").Columns(1)
Set tRange = tRange.Find(What:=EditRecordNo, LookIn:=xlValues, LookAt:=xlWhole)
If Not tRange Is Nothing Then
srow = tRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
ExDataDisp srow
End If
ElseIf EditRecordNo < 0 Then
ExFillterPrintPreview
End If
End Sub
抽出ユーザーフォームコード
下記のコードを追加してください
'印刷ボタン
Private Sub CommandButton8_Click()
EditRecordNo = -1
Unload Me
End Sub
実行結果
会社名に「産業」が含まれるデータを抽出
抽出結果の印刷プレビュー画面