自作アドイン - mieyanman @ ウィキ

Sub シート設定()

   ActiveWindow.DisplayGridlines = False

   ActiveCell.CurrentRegion.Select
   
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   With Selection.Borders(xlEdgeLeft)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeTop)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlInsideVertical)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   With Selection.Borders(xlInsideHorizontal)
       .LineStyle = xlContinuous
       .ColorIndex = xlAutomatic
       .TintAndShade = 0
       .Weight = xlThin
   End With
   
   Selection.EntireColumn.AutoFit
   
   ActiveCell.CurrentRegion.Rows(1).Select
   
   With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .ThemeColor = xlThemeColorAccent5
       .TintAndShade = 0.799981688894314
       .PatternTintAndShade = 0
   End With
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With

   ActiveCell.CurrentRegion.Cells(1, 1).Select

End Sub

Sub ページ設定()

   Application.PrintCommunication = False
   With ActiveSheet.PageSetup
       .PrintTitleRows = "$1:$1"
       .PrintTitleColumns = ""
   End With
   Application.PrintCommunication = True
   ActiveSheet.PageSetup.PrintArea = ""
   Application.PrintCommunication = False
   With ActiveSheet.PageSetup
       .LeftHeader = ""
       .CenterHeader = "&A"
       .RightHeader = Format(Date, "yyyy.MM.dd") & Chr(10) & "NMHIS中川雅隆"
       .LeftFooter = ""
       .CenterFooter = "&P/&N"
       .RightFooter = ""
       .LeftMargin = Application.InchesToPoints(0.708661417322835)
       .RightMargin = Application.InchesToPoints(0.708661417322835)
       .TopMargin = Application.InchesToPoints(0.748031496062992)
       .BottomMargin = Application.InchesToPoints(0.748031496062992)
       .HeaderMargin = Application.InchesToPoints(0.31496062992126)
       .FooterMargin = Application.InchesToPoints(0.31496062992126)
       .PrintHeadings = False
       .PrintGridlines = False
       .PrintComments = xlPrintNoComments
       .PrintQuality = 600
       .CenterHorizontally = False
       .CenterVertically = False
       Select Case MsgBox("縦にしますか。", vbYesNo Or vbSystemModal, "印刷の向き")
           Case vbYes
               .Orientation = xlPortrait
           Case Else
               .Orientation = xlLandscape
       End Select
       .Draft = False
       Select Case MsgBox("A4にしますか。", vbYesNo Or vbSystemModal, "用紙サイズ")
           Case vbYes
               .PaperSize = xlPaperA4
           Case Else
               .PaperSize = xlPaperA3
       End Select
       .FirstPageNumber = xlAutomatic
       .Order = xlDownThenOver
       .BlackAndWhite = False
       .Zoom = False
       .FitToPagesWide = 1
       Select Case MsgBox("1ページにおさめますか。", vbYesNo Or vbSystemModal, "ページ合わせ")
           Case vbYes
               .FitToPagesTall = 1
           Case Else
               .FitToPagesTall = False
       End Select
       .PrintErrors = xlPrintErrorsDisplayed
       .OddAndEvenPagesHeaderFooter = False
       .DifferentFirstPageHeaderFooter = False
       .ScaleWithDocHeaderFooter = True
       .AlignMarginsHeaderFooter = True
       .EvenPage.LeftHeader.Text = ""
       .EvenPage.CenterHeader.Text = ""
       .EvenPage.RightHeader.Text = ""
       .EvenPage.LeftFooter.Text = ""
       .EvenPage.CenterFooter.Text = ""
       .EvenPage.RightFooter.Text = ""
       .FirstPage.LeftHeader.Text = ""
       .FirstPage.CenterHeader.Text = ""
       .FirstPage.RightHeader.Text = ""
       .FirstPage.LeftFooter.Text = ""
       .FirstPage.CenterFooter.Text = ""
       .FirstPage.RightFooter.Text = ""
   End With
   Application.PrintCommunication = True

End Sub

Sub シートの集約()

   Dim wb As Workbook
   Dim i As Integer
   Dim w_Name As String

   For Each wb In Workbooks
       If i = 0 Then
           w_Name = wb.Name
       Else
           wb.Sheets(1).Move After:=Workbooks(w_Name).Sheets(i)
       End If
       i = i + 1
   Next

End Sub