ページ設定 ヘッダーを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 = "&""ＭＳ ゴシック,太字""&16" & strName

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

Next intFor(1)

End With

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

Set shtKyudanName = Nothing
Set shtHyou = Nothing

End Sub
 

 

2000年01月01日|[VBサンプルコード]:[ページ設定]