Excel2016 になっても入れている個人用マクロのまとめ

2017年度が始まりましたね。どうもどうも。

Excel 2013 から微妙に変わった Excel2016 が微妙に使いづらくて、慣れないけど頑張って使っている。ただ、そもそも前職より格段に使用頻度が下がってひとまず幸せ。

使用頻度が下がったとはいっても、以下のマクロあたりは「個人用マクロ」に仕込んでおくと、個人的に作業スピードが上がる。

Option Explicit

' 赤枠のオブジェクトを挿入する
' 普段は Ctrl + Shift + S を設定している
Sub 赤枠()
  ' Left, Top, Width, Height
  ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, ActiveCell.Left, ActiveCell.Top, 144, 45).Select
  With Selection.ShapeRange
    .Fill.Visible = msoFalse
    With .Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Weight = 1.5
    End With
    With .TextFrame2
      .TextRange.ParagraphFormat.Alignment = msoAlignCenter
      .VerticalAnchor = msoAnchorMiddle
      With .TextRange.Font
        .NameComplexScript = "メイリオ"
        .NameFarEast = "メイリオ"
        .Name = "メイリオ"
        .Size = 9
        With .Fill
          .Visible = msoTrue
          .ForeColor.RGB = RGB(0, 0, 0)
          .Transparency = 0
          .Solid
        End With
      End With
    End With
  End With
End Sub

' 赤枠のフキダシを挿入する
' 普段は Ctrl + Shift + D を設定している
Sub 赤フキダシ()
  ' Left, Top, Width, Height
  ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, ActiveCell.Left, ActiveCell.Top, 144, 45).Select
  With Selection.ShapeRange
    With .Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 255, 255)
      .Transparency = 0
      .Solid
    End With
    With .Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Weight = 1.5
    End With
    With .TextFrame2.TextRange.Font
      .NameComplexScript = "メイリオ"
      .NameFarEast = "メイリオ"
      .Name = "メイリオ"
      .Size = 9
      With .Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
      End With
    End With
  End With
End Sub

' セルを縦方向に結合する
' クイックアクセスツールバーに置いて使っている
' http://neos21.hatenablog.com/entry/2017/03/03/002937
' https://memo.xight.org/2010-02-24-1
' http://qiita.com/AfricaUmare/items/2602cd80290cd5a41eaf
Sub 縦方向に結合()
  On Error Resume Next
  ' 選択範囲がセルでない時は動作させない
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
  
  With Selection
    If .Rows.Count > 1 Then
      Dim i As Integer
      For i = 0 To .Columns.Count - 1
        range(Cells(.Row, .Column + i), Cells(.Row + .Rows.Count - 1, .Column + i)).Merge
      Next i
    End If
  End With
  
  On Error GoTo 0
End Sub

' 空行が混じっても崩れない連番を振る
' http://neos21.hatenablog.com/entry/2016/01/26/015250
Sub 縦に連番()
  Selection.Formula = "=IFERROR(MAX(INDIRECT(ADDRESS(1, COLUMN())):INDIRECT(ADDRESS(ROW() - 1, COLUMN()))) + 1, 1)"
End Sub

' 空行が混じっても崩れない連番を振る
' http://neos21.hatenablog.com/entry/2016/01/26/015250
Sub 横に連番()
  Selection.Formula = "=IFERROR(MAX(INDIRECT(ADDRESS(ROW(), 1)):INDIRECT(ADDRESS(ROW(), COLUMN() - 1))) + 1, 1)"
End Sub

' よく使う日付の書式
Sub 日付書式()
  With Selection
    .NumberFormatLocal = "yyyy-mm-dd"
    .HorizontalAlignment = xlCenter
  End With
End Sub

' よく使う日付の書式
Sub 日付書式曜日入り()
  With Selection
    .NumberFormatLocal = "yyyy-mm-dd (aaa)"
    .HorizontalAlignment = xlCenter
  End With
End Sub

' Excel2016 から「コメント」オブジェクトのフォント設定ができなくなったようなのでマクロで修正する
' http://www.moug.net/tech/exvba/0050137.html
' http://www.relief.jp/itnote/archives/018465.php
Sub 選択セルのコメント書式を変更()
  If TypeName(ActiveCell.Comment) = "Nothing" Then
    MsgBox "コメントなし"
    Exit Sub
  End If
  With ActiveCell.Comment.Shape.TextFrame.Characters.Font
    .Name = "メイリオ"
    .Size = 9
    .Bold = False
  End With
End Sub

' Excel2016 から「コメント」オブジェクトのフォント設定ができなくなったようなのでマクロで修正する
' http://www.relief.jp/itnote/archives/excel-vba-for-each-loop-cells-having-comment.php
Sub シート内の全コメント書式を変更()
  On Error GoTo COMMENT_NOT_FOUND
  Dim range As range
  For Each range In ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
    With range.Comment.Shape.TextFrame.Characters.Font
      .Name = "メイリオ"
      .Size = 9
      .Bold = False
    End With
  Next range
  Exit Sub
  
COMMENT_NOT_FOUND:
  Err.Clear
  MsgBox "コメントなし"
End Sub

他にもテンプレートを仕込んでいるけど、Excel2016 になってからテンプレートの保存先が変わったようなのでメモメモ。

起動時のスタート画面を表示しない設定の場合は、Book.xltx (テンプレート) と Personal.xlsb (個人用マクロ) は以下に置く。

C:\Users\【ユーザ】\AppData\Roaming\Microsoft\Excel\XLSTART\