ExcelVBA : 全シート内太文字の名前作成

開いているブックの全シート中の太文字のセル位置で、そのテキストで「名前」を作成するマクロだ。

何に使うかってーと、簡易目次だ。
ブック内の任意シートで「CTRL+G」を押せば名前を選択して、そのセルにジャンプしてくれる。
ま、同じ内容の太文字テキストが複数あった場合、あきらめてくれ。
その名前のみ、手動で名前作成すればイイんじゃね？

VBAのつぼ
今回のシート内全セルループは印刷範囲とデータ存在範囲のうち小さい行桁でループをまわしてる。
セルループのテンプレにつかえし。

ループ中、DoEventとStatusBar文字変更は、暴走疑惑を和らげる為だ。

Sub 太文字名前登録() For Each sh In ActiveWorkbook.Sheets sh.Activate DoEvents Application.StatusBar = sh.Name If sh.PageSetup.PrintArea <> "" Then cnt = sh.Range(sh.PageSetup.PrintArea).Cells.Count rp = sh.Range(sh.PageSetup.PrintArea).Cells(cnt).Row cp = sh.Range(sh.PageSetup.PrintArea).Cells(cnt).Column Else rp = 65535 cp = 65535 End If If sh.Cells.SpecialCells(xlLastCell).Row < rp Then rp = sh.Cells.SpecialCells(xlLastCell).Row If sh.Cells.SpecialCells(xlLastCell).Column < cp Then cp = sh.Cells.SpecialCells(xlLastCell).Column For y = 1 To rp For x = 1 To cp If Len(sh.Cells(y, x)) <> 0 Then If sh.Cells(y, x).Font.Bold = True Then sh.Range(Cells(y, x), Cells(y, x + 1)).Select Selection.CreateNames Top:=False, Left:=False, Bottom:=False, Right:=True Application.StatusBar = sh.Name & "(" & y & "," & x & ")" End If End If Next Next Next Application.StatusBar = "" End Sub