Excel VBA練習 PageSetup

以下の使い方の確認用の練習用マクロです。

• PageSetup
• Range.Value
• Shape.TextFrame2.TextRange.Text

' Excel 2019
' Windows 10

Option Explicit

Public Sub Main()
  Dim app As Excel.Application
  Dim wb As Excel.Workbook
  Dim ws As Excel.Worksheet
  Dim shp As Excel.Shape
  Dim txtFr As Excel.TextFrame
  Dim txtFr2 As Excel.TextFrame2
  Dim txtRng2 As Office.TextRange2
  Dim rng As Excel.Range

  Set app = New Excel.Application
  app.Visible = True

  Set wb = app.Workbooks.Add(Template:=Excel.XlWBATemplate.xlWBATWorksheet)

  Set ws = wb.Sheets(1)
  ws.Name = "Sheet1"

  ' 特に意味なし
  Set ws = Nothing
  Set ws = wb.Sheets("Sheet1")

  ' ページ設定
  With ws.PageSetup
    ' [ページ]
    ' <印刷の向き>
    .Orientation = Excel.XlPageOrientation.xlLandscape
    ' <拡大縮小印刷>
    .Zoom = 100
    ' --------------------------
    .PaperSize = Excel.XlPaperSize.xlPaperA3
    .PrintQuality = Array(600, 600)
    .FirstPageNumber = Excel.Constants.xlAutomatic

    ' [余白]
    .LeftMargin = Excel.Application.CentimetersToPoints(Centimeters:=2)
    .RightMargin = Excel.Application.CentimetersToPoints(Centimeters:=2)
    .TopMargin = Excel.Application.CentimetersToPoints(Centimeters:=1)
    .BottomMargin = Excel.Application.CentimetersToPoints(Centimeters:=1)
    .HeaderMargin = Excel.Application.CentimetersToPoints(Centimeters:=0.5)
    .FooterMargin = Excel.Application.CentimetersToPoints(Centimeters:=0.5)
    ' <ページ中央>
    .CenterHorizontally = False
    .CenterVertically = False

    ' [ヘッダー/フッター]
    ' ヘッダーとフッターの書式は、
    ' Docsの"Formatting and VBA codes for headers and footers"を参照。
    .LeftHeader = " &""ＭＳ ゴシック""&09 &P / &N 左側ヘッダー "
    .CenterHeader = " &""ＭＳ ゴシック""&09 &P / &N 中央部ヘッダー "
    .RightHeader = " &""ＭＳ ゴシック""&09 &P / &N 右側ヘッダー "
    .LeftFooter = " &""ＭＳ ゴシック""&09 &P / &N 左側フッター "
    .CenterFooter = " &""ＭＳ ゴシック""&09 &P / &N 中央部フッター "
    .RightFooter = " &""ＭＳ ゴシック""&09 &P / &N 右側フッター "
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = False
    .AlignMarginsHeaderFooter = True

    ' [シート]
    .PrintArea = "A1:Z52"
    .PrintTitleRows = "1:1"
    .PrintTitleColumns = "A:A"
    ' <印刷>
    .PrintGridlines = False
    .BlackAndWhite = False
    .Draft = False
    .PrintHeadings = False
    .PrintComments = Excel.XlPrintLocation.xlPrintInPlace
    .PrintErrors = Excel.XlPrintErrors.xlPrintErrorsDisplayed
    ' <ページの方向>
    .Order = Excel.XlOrder.xlDownThenOver
  End With

  ' ワークシート上にテキストボックスを追加
  Set shp = ws.Shapes.AddTextbox( _
    Orientation:=Office.MsoTextOrientation.msoTextOrientationHorizontal, _
    Left:=ws.Range("G7").Left, _
    Top:=ws.Range("G7").Top, _
    Width:=ws.Range("H7").Left - ws.Range("G7").Left, _
    Height:=ws.Range("G8").Top - ws.Range("G7").Top _
    )
  shp.Name = "テキスト ボックス 1000"

  ' 特に意味なし
  Set shp = Nothing
  Set shp = ws.Shapes("テキスト ボックス 1000")

  ' 図形の書式設定 サイズ
  shp.LockAspectRatio = Office.MsoTriState.msoFalse

  ' 図形の書式設定 プロパティ
  shp.Placement = Excel.XlPlacement.xlMove
  shp.ControlFormat.PrintObject = True

  ' 図形の書式設定 テキストボックス
  Set txtFr = shp.TextFrame
  With txtFr
    ' テキストを図形からはみ出して表示する
    .HorizontalOverflow = Excel.XlOartHorizontalOverflow.xlOartHorizontalOverflowOverflow
    .VerticalOverflow = Excel.XlOartVerticalOverflow.xlOartVerticalOverflowOverflow
  End With

  Set txtFr2 = shp.TextFrame2
  With txtFr2
    ' 垂直方向の配置
    .VerticalAnchor = Office.MsoVerticalAnchor.msoAnchorMiddle
    ' テキストに合わせて図形のサイズを調整する
    .AutoSize = Office.MsoAutoSize.msoAutoSizeNone
    ' 余白
    .MarginLeft = Excel.Application.CentimetersToPoints(Centimeters:=0)
    .MarginRight = Excel.Application.CentimetersToPoints(Centimeters:=0)
    .MarginTop = Excel.Application.CentimetersToPoints(Centimeters:=0)
    .MarginBottom = Excel.Application.CentimetersToPoints(Centimeters:=0)
    ' 図形内でテキストを折り返す
    .WordWrap = Office.MsoTriState.msoFalse
  End With

  Set txtRng2 = txtFr2.TextRange
  With txtRng2
    .Text = "G7セル"
    .Font.Name = "ＭＳ ゴシック"
    .Font.NameFarEast = "ＭＳ ゴシック"
    .Font.Size = 9
    .Font.Fill.ForeColor.RGB = VBA.Information.RGB(Red:=0, Green:=0, Blue:=192)
  End With

  ' 図形の書式設定 塗りつぶし
  With shp.Fill
    .Visible = Office.MsoTriState.msoFalse
  End With

  ' 図形の書式設定 線
  With shp.Line
    .Visible = Office.MsoTriState.msoTrue
    .ForeColor.RGB = VBA.Information.RGB(Red:=0, Green:=0, Blue:=192)
    .Transparency = 0
    .Weight = 0.5
    .Style = Office.MsoLineStyle.msoLineSingle
    .DashStyle = Office.MsoLineDashStyle.msoLineSolid
  End With

  Set rng = ws.Range("A1")
  rng.Value = "A1セル"
  rng.Name = "名前A1"
  rng.Name.Visible = True

  Set rng = ws.Cells(2, 2)
  rng.Value = "B2セル"
  rng.Name = "Sheet1!名前B2"
  rng.Name.Visible = True

  Set rng = ws.Range("A1:Z26")
  rng.Cells(3, 3).Value = "C3セル"
  wb.Names.Add Name:="名前C3", RefersTo:="=Sheet1!$C$3", Visible:=True

  Set rng = ws.Range(ws.Cells(2, 2), ws.Cells(256, 256))
  rng.Cells(3, 3).Value = "D4セル"
  ws.Names.Add Name:="名前D4", RefersTo:="=Sheet1!$D$4", Visible:=True

  Set rng = ws.Rows(5)
  rng.Cells(1, 5).Value = "E5セル"
  rng.Name = "Sheet1!名前E5"
  rng.Name.Visible = True

  Set rng = ws.Range("A7:Z26").Columns("G")
  rng.Cells(0, 0).Value = "F6セル"
  rng.Name = "Sheet1!名前F6"
  rng.Name.Visible = True

  With ws.Range("A1:F6")
    .Font.Name = "ＭＳ ゴシック"
    .Font.Size = 9
    .Font.Color = VBA.Information.RGB(Red:=192, Green:=0, Blue:=0)
    .Interior.Color = VBA.Information.RGB(Red:=255, Green:=255, Blue:=0)
  End With

End Sub