ページ設定 ヘッダーを1枚毎変えながら印刷する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][ページ設定 ヘッダーを1枚毎変えながら印刷する]

Sub ヘッダーを変えながら印刷する()
'
' 手書表 (1)を指定枚数、ヘッダーを変えながら印刷する。
'
'
Const strX As String = "ヘッダーを変えながら印刷する"
Dim shtKyudanName As Worksheet
Dim shtHyou As Worksheet
Dim strPrintSuu As String
Dim strName As String

'
If MsgBox("手書表を印刷しますか?", vbOKCancel, strX) = vbCancel Then Exit Sub

MyRE:
strPrintSuu = InputBox("何枚づつ印刷しますか?", strX, 1)

If IsNumeric(strPrintSuu) = False Then
If MsgBox("数値で入力されていません!もう一度入力しますか?", vbYesNo + vbCritical, strX) = vbNo Then
Exit Sub
Else
GoTo MyRE:
End If
End If

Set shtKyudanName = ThisWorkbook.Sheets("球団名")
Set shtHyou = ThisWorkbook.Sheets("手書表 (1)")

Dim intKyudanSuu As Integer, intFor(1) As Integer

With shtKyudanName

intKyudanSuu = .Range("b1").CurrentRegion.Rows.Count

For intFor(1) = 2 To intKyudanSuu

strName = .Range("b" & intFor(1)).Value

shtHyou.PageSetup.LeftHeader = "&""MS ゴシック,太字""&16" & strName

shtHyou.PrintOut Copies:=CLng(strPrintSuu), Collate:=True

Next intFor(1)

End With

' .LeftHeader = "&""MS ゴシック,太字""&16広島"

Set shtKyudanName = Nothing
Set shtHyou = Nothing

End Sub
 





Production Japan Import Application. Since 1998