Attribute VB_Name = "M" Sub 原稿用紙作成() With ActiveDocument.Styles(wdStyleNormal).Font If .NameFarEast = .NameAscii Then .NameAscii = "" End If .NameFarEast = "" End With ActiveDocument.Content.Orientation = wdTextOrientationVerticalFarEast With ActiveDocument.PageSetup .LineNumbering.Active = False .Orientation = wdOrientLandscape .TopMargin = MillimetersToPoints(20) .BottomMargin = MillimetersToPoints(20) .LeftMargin = MillimetersToPoints(20) .RightMargin = MillimetersToPoints(20) .Gutter = MillimetersToPoints(0) .HeaderDistance = MillimetersToPoints(15) .FooterDistance = MillimetersToPoints(17.5) .PageWidth = MillimetersToPoints(210) .PageHeight = MillimetersToPoints(297) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBin .SectionStart = wdSectionNewPage .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .VerticalAlignment = wdAlignVerticalTop .SuppressEndnotes = False .MirrorMargins = False .TwoPagesOnOne = False .BookFoldPrinting = False .BookFoldRevPrinting = False .BookFoldPrintingSheets = 1 .GutterPos = wdGutterPosLeft .LayoutMode = wdLayoutModeLineGrid End With Dim iGyo, iRetsu As Integer iGyo = InputBox("タテの文字数?", "1行の文字数", 20) iRetsu = InputBox("行数?", "行数", 1) ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=iGyo, NumColumns:= _ iRetsu, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed With Selection.Tables(1) If .Style <> "表 (格子)" Then .Style = "表 (格子)" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = True .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = True End With With Selection .MoveRight unit:=wdCharacter, Count:=iRetsu, Extend:=wdExtend .MoveDown unit:=wdLine, Count:=iGyo - 1, Extend:=wdExtend .Orientation = wdTextOrientationVerticalFarEast .Rows.HeightRule = wdRowHeightExactly .Rows.Height = MillimetersToPoints(10.5) .Columns.PreferredWidthType = wdPreferredWidthPoints .Columns.PreferredWidth = MillimetersToPoints(10.5) .ParagraphFormat.Alignment = wdAlignParagraphCenter .Cells.VerticalAlignment = wdCellAlignVerticalCenter .MoveLeft unit:=wdCharacter, Count:=1 End With With Selection.Tables(1) With .Borders(wdBorderLeft) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With With .Borders(wdBorderRight) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With With .Borders(wdBorderTop) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With With .Borders(wdBorderBottom) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With With .Borders(wdBorderHorizontal) .LineStyle = wdLineStyleDashLargeGap .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With With .Borders(wdBorderVertical) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth025pt .Color = wdColorAutomatic End With .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone .Borders.Shadow = False End With Selection.Collapse End Sub