DoEventsとApplication.StatusBar

ファイル読み込み時のループなどの場合、この2つをセットで書いておくとよい
（DoEventsでOSに制御がわたり、Escキーが有効になり、ステイタスバーの表示が更新される）。

With CreateObject("Scripting.FileSystemObject")
     For Each ファイル In .GetFolder("C:\Sample").Files 'フォルダ内繰り返し
          icnt = icnt + 1
          DoEvents
          Application.StatusBar = "ファイル読込 (" & icnt & ")" & ファイル.name
          'ファイル読込ルーチンを記述
     Next ファイル
End With

文字単位の色指定

        With ActiveSheet.Cells(行, 列).Characters(Start:=n, length:=1).Font
            .Bold = True
            '.ColorIndex = 7
            .Color = RGB(255, 0, 255) 'ﾋﾟﾝｸ　#FF00FF / RGB(255,0,255) / 16711935
        End With

フリガナで並べ替え（フリガナが入ってなければ自動読みで挿入）

    Dim セル As Range
    Dim 選択範囲 As Variant

    '(1)フリガナが入ってなければ自動読みで挿入
    For Each セル In 選択範囲
        If VarType(セル) = vbString Then
            If セル.Characters.PhoneticCharacters = "" Then
                セル.SetPhonetic
            End If
        End If
    Next セル
     
    '(2)一覧をフリガナで並べ替え
    選択範囲.Sort Key1:=選択範囲(1), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin, DataOption1:=xlSortNormal

    '自動読みのフリガナの不具合はフリガナの修正をおこなう（2回目以降はそのフリガナで並ぶ）

指定フォルダ以下を再帰的更新

Sub 予算表数式一括更新()
    Call freezeexcel
    Call 再帰更新("C:\Users\sys01\Documents\予算表数式更新\TEST")
    Call meltexcel
    MsgBox "処理完了"
End Sub

Sub 再帰更新(パス As String)
    'フォルダの下の全予算表の全シートを変更

    Dim FSO As Object
    Dim フォルダ As Object
    Dim サブフォルダ As Object
    Dim ファイル As Object
    Dim wb As Workbook
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set フォルダ = FSO.GetFolder(パス)
    For Each サブフォルダ In フォルダ.SubFolders
        'フォルダ内のサブフォルダを処理（サブフォルダがなければループ内は通らず）
        再帰更新 サブフォルダ.Path '再帰的呼び出し
    Next サブフォルダ
 
    For Each ファイル In フォルダ.Files 'カレントフォルダ内のファイルを処理
        If (InStr(ファイル.Name, "xlsm") > 0) Then
            'Debug.Print ファイル.Name, ファイル.Path, ファイル.Size
            Set wb = Workbooks.Open(Filename:=ファイル.Path)
            'やりたいことを記述
            wb.Close SaveChanges:=True
        End If
    Next ファイル
End Sub

EXCELから複数シートを小さいPDFにバッチで書き出す方法

EXCEL(2010)から標準のPDF保存ではサイズが大きくなり、メール添付に適さないための対策
(1)CubePDFを使用する http://www.cube-soft.jp/cubepdf/
(2)各シートの解像度が変わる場合（全列・全行を1ページに収める場合など）は、CubePDFで1シートづつ印刷して、CubePDF側のダイアログの設定で書き出したPDFに追記する
（Excel は複数シートを選択して印刷をかけた時、ページ毎の設定が異なっている場合に「1 ページ毎に印刷コマンドを実行する」と言う挙動を示す事があるため）
　-----株式会社キューブ・ソフトのサポートからのご教示による
　http://support.microsoft.com/kb/816935/ja
　http://okwave.jp/qa/q6118128.html

以上の条件に沿ったVBAのソースコードは下記

Public Function CubePDF書き出しsub(シート名配列 As Variant, 生成PDFファイルパス As String)
    Dim n As Integer
    Dim print_name As String
    Dim ws As Worksheet
    Dim cuHw As Long
    Dim cuHw2 As Long
    Dim シート名 As Variant
 
    print_name = Application.ActivePrinter '現在使用しているプリンター名を取得しておく
    n = 0
    For Each シート名 In シート名配列
        ThisWorkbook.Sheets(シート名).PrintOut ActivePrinter:="CubePDF"
        '個々のシートをCubePDFで印刷
     
        Sleep 5000 '印刷起動後5秒停止（原始的だが時間指定で待機）
        cuHw = 0
        Do  '「CubePDF 1.0.0RC8 (x86)」のダイアログのハンドルを取得するまでループ
            cuHw = FindWindow(vbNullString, "CubePDF 1.0.0RC8 (x86)")  'タイトルで指定
        Loop While cuHw = 0
        BringWindowToTop cuHw  
       '「CubePDF 1.0.0RC8 (x86)」のウィンドウをアクティブに(Windows7)
     
        Sleep 1000 '1秒停止
       '「CubePDF 1.0.0RC8 (x86)」のダイアログのファイル名パスに書き込み
       '（起動後に表示されるダイアログにパラメタを入力するテクニック）
       '感謝→ http://okwave.jp/qa/q8318460.html
        With CreateObject("Wscript.Shell")

            .SendKeys "{TAB}"

            .SendKeys "{TAB}"
            .SendKeys "{TAB}"
            .SendKeys "{TAB}"
            .SendKeys "{TAB}"
            .Run "%COMSPEC% /c echo " & 生成PDFファイルパス & "| clip", 0, True
            'クリップボードに生成PDFファイルパスをコピー
            .SendKeys "^v" '貼り付け
            .SendKeys "{ENTER}"
        End With
        If (n > 0) Then
        　　'2シート目以降は「CubePDF 確認」ダイアログのハンドルを取得するまでループ
        　　'（CubePDF側で「末尾に結合」の設定になっていることが必須）
            cuHw2 = 0
            Do
                cuHw2 = FindWindow(vbNullString, "CubePDF 確認")  'タイトルで指定
            Loop While cuHw2 = 0
            BringWindowToTop cuHw2 'ウィンドウをアクティブに(Windows7)
         
            Sleep 1000 '1秒停止
            With CreateObject("Wscript.Shell")
                .SendKeys "{ENTER}" '「CubePDF 確認」のダイアログのボタンを押す
            End With
        End If
        n = n + 1
    Next
    Application.ActivePrinter = print_name  'プリンター名を元に戻す
    CubePDF書き出しsub = 生成PDFファイルパス
End Function