※ ChatGPTを利用し、要約された質問です(原文:Excel2010のVBAでライトヘッダーが出ない)
Excel2010のVBAでライトヘッダーが出ない
このQ&Aのポイント
Excel2010のVBAでライトヘッダーの日付が印刷されない現象が発生しています。問題を解決するために修正する必要があります。
Excel2010のVBAでライトヘッダーの日付が印刷されない理由と、それを修正するための手順について教えてください。
Excel2010のVBAでライトヘッダーの日付が表示されない問題が発生しています。日付が出力されるように修正する方法を教えてください。
Excel2010のVBAでライトヘッダーが出ない
2020/10/12 OKウェイヴ 質問
Excel2010にて、VBAで以下を実行すると
ライトヘッダーの日付が印刷されません。
ライトヘッダーの日付が出力されるようにするには
どの部分をどのように修正する必要があるでしょうか。
日付が表示されない理由、表示されるようになるための修正点を教えていただきますようお願いします。
※初心者が記録されたマクロを修正しただけなので コードが汚いなどは気にしないでください。
また、テキスト部分は内容を修正してあります。
Cells(1, 1).Select
Application.PrintCommunication = False
Worksheets(Worksheets.Count).Copy After:=Worksheets(Worksheets.Count)
With ActiveSheet.PageSetup
.RightHeader = "&""メイリオ,レギュラー""&D"
.LeftFooter = "&""メイリオ,レギュラー""テキスト" & vbLf & "テキスト"
.RightFooter = "&""メイリオ,レギュラー""テキスト" & vbLf & "テキスト" & vbLf & "テキスト"
.LeftMargin = Application.InchesToPoints(0.984251968503937)
.RightMargin = Application.InchesToPoints(0.984251968503937)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1.18110236220472)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.4)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.PrintTitleRows = "$1:$1"
End With
Range("U:U").AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("ZZ1"), Unique:=True
Range("A1").AutoFilter Field:=17, Criteria1:="<>"
Range("A1", Selection.End(xlToRight)).EntireColumn.AutoFit
Selection.ShrinkToFit = True
Range("A:L,N:P,R:V,ZZ:ZZ").EntireColumn.Hidden = True
Range("A1", Selection.End(xlToRight)).EntireColumn.Select
ActiveSheet.PageSetup.PrintArea = ActiveCell.CurrentRegion.Address
With Selection.Font
.Name = "Meiryo UI"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Dim i As Integer
i = 2
Do While Cells(i, "ZZ") <> ""
Range("A1").AutoFilter Field:=21, Criteria1:=Cells(i, "ZZ")
If Cells(Rows.Count, "Q").End(xlUp) <> "参照先" Then
ActiveSheet.PageSetup.LeftHeader = "&""メイリオ,レギュラー""" & Cells(Rows.Count, "U").End(xlUp) & "テキスト" & vbLf & "テキスト"
Application.PrintCommunication = True
ActiveSheet.PrintOut
Application.PrintCommunication = False
End If
i = i + 1
Loop
Range("B2").Select
End Sub
お礼
ありがとうございました。 フォントの指定をやめて、 "&D" を教えていただいたコードに差し替えたら うまくいきました。 "&D"ではうまくいかないんですね。