項目

｢このファイルは最新版の...｣のメッセージを出さずにExcel97で保存

内容説明

Excel2000以降で保存したBookをたまたまExcel97で保存したとき｢このファイルは最新版のMicrosoftExcelで作成されました...｣とダイアログボックスが表示される場合があります。
このダイアログボックスを表示させずにマクロで上書き保存する方法です。

Sub test_kSave97Use()
  kSave97Use ActiveWorkbook
End Sub

'下位バージョン(97)で上書き保存した場合に｢このファイルは最新版の...｣
'とメッセージが表示されるのを防いで保存する
'wb：上書き保存するBook
Function kSave97Use(wb As Workbook)
  Dim fdt As Date
  With wb '保存するbook
    fdt = FileDateTime(.FullName) 'ファイルの保存日時を退避
    Application.DisplayAlerts = False 'メッセージを非表示
    .Save '上書き保存
    Application.DisplayAlerts = True 'メッセージを表示
    If fdt = FileDateTime(.FullName) Then '保存不成功(メッセージが出る状態)
      SendKeys "Y"
      .Save
    End If
  End With
End Function

項目

マクロの実行を指定した秒数停止する

内容説明

マクロの中でちょっとしたWaitをかけたい場合があります。指定した秒数だけ停止するkWaitS関数です。

'実行中のマクロを指定した秒数停止します
'WaitメソッドはExcel動作を停止しますが印刷や再計算などのバックグラウンド処理は続行されます
'引数 sec:停止する秒数(0〜59)
Sub kWaitS(sec)
  Application.Wait Now() + TimeSerial(0, 0, sec)
End Sub

関連)マクロの実行時間を計る
Timer 関数を使うのが簡単です。
  Dim tm!
  tm = Timer
  '処理
  MsgBox Timer - tm & "秒"

項目

マクロの実行中にユ−ザ−フォ−ムでメッセージを表示する

内容説明

マクロで時間のかかる処理を行う場合にユ−ザ−フォ−ムで｢実行中です...｣等のメッセージを表示する方法です。ダイアログボックスで行う方法は後述します。
[標準モジュール]に次のようなUserFormを表示する関数を入力します。

'ユーザーフォームを表示
Sub test_E97M028()
  UserForm1.Show
End Sub

ユーザーフォーム[UserForm1] を作成し、Activateイベントに以下のコードを入力します。

'実際に処理をするルーチンを指定
Private Sub UserForm_Activate()
  'test '実際に処理をする関数
  '又は以下のように処理を直接記述
  Dim ii&, dd
  DoEvents
  For ii = 1 To 500
    dd = dd + ii
    Worksheets("Sheet1").Cells(1, 1).Value = dd
    Worksheets("Sheet1").Cells(2, 1).Value = Int(ii / 5) & "%"
  Next
  '
  '
  Unload Me
End Sub

test_E97M028関数を実行すると、計算処理が終了するまでユ−ザ−フォ−ムを表示し続けます。
これは手順のみを示しています。ユ−ザ−フォ−ムの体裁などは好みに処置して下さい。

次に、実際の処理中にダイアログで｢実行中です...｣等のメッセージを表示するkDlgIng関数を示します。
テストはtest_E97M028b関数を実行します。test_proc関数は処理内容のサンプルです。

'標準モジュール
Option Explicit
Option Private Module
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
  ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long

'マクロで時間のかかる処理を行う場合にダイアログで｢実行中です...｣等のメッセージを表示する関数
'引数 mcr ダイアログ表示中に実行するマクロ名
'     msg ダイアログに表示するメッセージ。省略可
'     txt ダイアログのタイトル名。省略可
'ダイアログは"kDlgIng"と言う名前でユーザーが任意に作っておく事が出来ます
'ダイアログ"kDlgIng"が存在すればそれを用います。存在しなければプログラムで作成します
'ダイアログ"kDlgIng"が存在するときは引数msg､txtは無視します
Sub kDlgIng(mcr$, Optional msg$, Optional txt$)
  Dim ds As Object, ww&
  If txt = "" Then msg = "実行中です..."
  If txt = "" Then txt = "kDlgIng"    '引数省略時の処理
  ww = 0
  On Error Resume Next
  Application.ScreenUpdating = False '画面の更新を行わない
  Set ds = ThisWorkbook.DialogSheets("kDlgIng")
  If Err Then 'ダイアログの作成
    On Error GoTo 0
    ww = LenB(msg) * 5: If ww < 120 Then ww = 120 '幅サイズ
    DialogSheets.Add.Name = "kDlgIng" 'ダイアログ作成
    Set ds = ThisWorkbook.DialogSheets("kDlgIng")
    ds.Visible = False 'ダイアログシートを非表示
    ds.DialogFrame.Height = 45: ds.DialogFrame.Width = ww
    ds.DrawingObjects(2).Delete: ds.DrawingObjects(1).Delete
    ds.Labels.Add(60, 40, ww, 12).Name = "l"
    ds.DrawingObjects("l").Characters.Text = msg 'メッセージ
    ds.DialogFrame.Characters.Text = txt         'タイトル
  End If
  On Error GoTo 0
  ds.DialogFrame.OnAction = "kDlgIng1" 'ダイアログを開いたとき実行されるマクの設定
  kDlgIng2 (mcr)
  Application.ScreenUpdating = True
  ds.Show
  If ww Then 'ダイアログを作成したときは削除する
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    ds.Visible = True: ds.Delete
  End If
End Sub
Sub kDlgIng1() 'ダイアログを開いたとき実行されるマクロ
  If Application.Version < 7 Then
    Application.SendKeys ("{enter}"): MsgBox " " 'ダイアログ表示したままにするおまじない
  Else
    Dim hwnd As Long
    hwnd = FindWindow("bosa_sdm_XL", ActiveDialog.DialogFrame.Caption)
    If hwnd = 0 Then hwnd = FindWindow("bosa_sdm_XL" & Val(Application.Version), ActiveDialog.DialogFrame.Caption)
    ShowWindow hwnd, 1
    UpdateWindow (hwnd)
  End If
  Application.Run Macro:=kDlgIng2              '引数 mcrで指定されたマクロの実行
  ThisWorkbook.DialogSheets("kDlgIng").Hide    'ダイアログを閉じる
End Sub
Function kDlgIng2(Optional ss) '実行するマクロ名を引き渡す関数
  Static mcr
  If Not IsMissing(ss) Then mcr = ss
  kDlgIng2 = mcr
End Function

Sub test_E97M028b() 'マクロの実行中にダイアログメッセージを表示するkDlgIng関数のTEST
  kDlgIng "test_proc" ', "実行中です。", "test"
End Sub
Sub test_proc() '実際の処理関数のサンプル
  Dim xx&, yy&
  Sheets.Add
  For xx = 1 To 100
    For yy = 1 To 1000
      Cells(yy, xx).Value = yy + xx - 1
    Next
  Next
  Application.DisplayAlerts = False: ActiveWindow.SelectedSheets.Delete
End Sub

追記：プログレスバ−の表示
処理時間のかかるマクロを実行する時に経過を表示するプログレスバ−を表示する方法については ソフトウェア<Our Software> エクセルVBAテクニック集 kVBA1をご参照下さい。

項目

ステータスバーへ文字列を表示する

内容説明

マクロで時間のかかる処理を行う場合などにステータスバーへ任意の文字列を表示する関数を示します。

'ステータスバーへ文字列を表示します
'引数 msg 表示する文字列。 零文字列""を指定すると元のステータスバーへ戻す
'kStatusBar("xxx") のあと処理が済んだら必ず kStatusBar("") で元に戻す
Sub kStatusBar(msg$)
  Static sv
  If msg <> "" Then 'ステータスバーへ引数の文字列を表示
    sv = Application.DisplayStatusBar
    If sv = False Then Application.DisplayStatusBar = True
    Application.StatusBar = msg
  Else  '引数が""ならステータスバーを元へ戻す
    If sv = "" Then Exit Sub 'ステータスバーへ文字列を表示、が実行されてない
    Application.StatusBar = False
    If sv = False Then Application.DisplayStatusBar = False
    sv = ""
  End If
End Sub

'kStatusBar関数のTEST
'ステータスバーへ文字列を表示する   
Sub test_kStatusBar() 
  kStatusBar ("xxxを実行中です")
  MsgBox "ステータスバーへ文字列を表示しました。", , "kStatusBar"
  kStatusBar ("")
  MsgBox "元のステータスバーへ戻しました。", , "kStatusBar"
End Sub

項目

フォームがはみ出さないようダイアログのサイズを調整する

内容説明

ユーザーが作成したダイアログフレームを他のコンピュ−タで表示したときに配置された[エディットボックス]等のフォームがはみ出してしまう場合があります。
この現象はディスプレイドライバや使用フォントなどの影響で生じるようです。
フォームがはみ出た場合にダイアログフレームのサイズをはみ出さないよう調整するkDlgSize関数を示します。
ダイアログを表示するShowメソッドの前にkDlgSize関数を記述します。

'フォームがはみ出ないようダイアログのサイズを調整する
'引数 dlg ダイアログ名
'     flg 省略=幅と高さの調整、1=幅の調整、2=高さの調整
Sub kDlgSize(dlg$, Optional flg)
    If IsMissing(flg) Then flg = 0 '引数が省略
    Dim ds, dr, x0, x1, x2, y0, y1, y2
    On Error Resume Next
    Set ds = ThisWorkbook.DialogSheets(dlg)
    If Err Then MsgBox Error(Err), vbExclamation, "kDlgSize": Exit Sub
    On Error GoTo 0
    x0 = ds.DialogFrame.Left + ds.DialogFrame.Width
    y0 = ds.DialogFrame.Top + ds.DialogFrame.Height
    x2 = x0: y2 = y0
    For Each dr In ds.DrawingObjects '要素の終わりまで繰り返す
        x1 = dr.Left + dr.Width: If x0 < x1 Then x0 = x1
        y1 = dr.Top + dr.Height: If y0 < y1 Then y0 = y1
    Next
    If flg <> 2 And x2 < x0 Then ds.DialogFrame.Width = x0 - ds.DialogFrame.Left + 4.5
    If flg <> 1 And y2 < y0 Then ds.DialogFrame.Height = y0 - ds.DialogFrame.Top + 3.5
End Sub

'kDlgSize関数のTEST
'フォームがはみ出ないようダイアログのサイズを調整する
Sub test_kDlgSize() 
    kDlgSize "Dialog1"
    DialogSheets("Dialog1").Show
End Sub

注) Excel95までの[ダイアログ]からExcel97では[ユーザーフォーム]となりましたが、Excel97でも[ダイアログ]を用いる事は出来ます。新しい[ダイアログ]の挿入は[シート見出し]を右クリックし、[挿入]-[MS Excel5.0ダイアログ]を選択します。

項目

他のプログラムを起動し、そのプログラムが終了するまでExcelを待機する

内容説明

他のプログラムを起動しそのプログラムが終了するまでExcelを使用出来ないようにする関数を示します。Win32API関数を用います。

その1)　kEWait関数
途中でExcelに制御を戻したいときは、Excelをクリックし[Esc]キ−を押して強制終了する事が出来ます。
強制終了した場合は、起動したプログラムはそのままです。


'標準モジュール
Option Explicit
Option Private Module
Private Declare Function OpenProcess Lib "kernel32" ( _
  ByVal dwAccess As Long, ByVal fInherit As Long, ByVal IDProcess As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
  ByVal hProcess As Long, ByRef lpdwExitCode As Long) As Long
Const PROCESS_QUERY_INFORMATION = &H400

'他のプログラムを起動しそのプログラムが終了するまでExcelを使用不可にする
'引数 file 実行するプログラム名
'戻値 0 正常終了、0以外はエラー(異常終了) 18=強制終了
'Ctrl+Breakキー、Escキー等で強制終了します
Function kEWait(file As String) As Long
  Dim rt As Long, hd As Long, code As Long
  On Error Resume Next 'Shellはプログラムが実行できないとエラー発生
  rt = Shell(file, vbNormalFocus) ' プログラムを起動
  If Err Then kEWait = Err: Exit Function
  Do '起動を待つ
    DoEvents: Err = 0: AppActivate rt
  Loop While Err
  On Error GoTo 0
  hd = OpenProcess(PROCESS_QUERY_INFORMATION, True, rt) '起動したプロセスオブジェクトのハンドルを得る
  If hd = 0 Then kEWait = 1: Exit Function
  'Ctrl+Breakキー、Escキー等で中断
  Application.EnableCancelKey = xlErrorHandler
  On Error Resume Next
  Do
    If Application.Version < 8 Then DoEvents 'オペレーティングシステムに制御を渡す
    rt = GetExitCodeProcess(hd, code) 'プロセス状態を取得
    If Err = 18 Then kEWait = Err: Exit Function '中断
    If rt = 0 Then kEWait = 2: Exit Function
  Loop While (code = &H103) 'プロセスは継続している
End Function

'kEWait関数のTEST
'他のプログラムを起動し終了までExcelを待つ
Sub test_kEWait()
  Dim ii&
  ii = kEWait("CALC.EXE") '電卓を実行
  MsgBox IIf(ii, "異常終了しました Err=" & ii, "正常終了しました")
End Sub

その2)　kEWait2関数
起動したプログラムを終了しない限りExcelは待機状態です。途中でExcelに制御を戻す事は出来ません。

Private Declare Function OpenProcess Lib "kernel32" _
  (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
  (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const INFINITE = &HFFFF

'他のプログラムを起動しそのプログラムが終了するまでExcelを使用不可にする
'引数 file 実行するプログラム名
'戻値 0 正常終了、0以外はエラー(異常終了)
Function kEWait2(file As String) As Long
  Dim rt As Long, hd As Long
  On Error Resume Next 'Shellはプログラムが実行できないとエラー
  rt = Shell(file, vbNormalFocus)  'プログラムを起動
  If Err Then kEWait2 = Err: Exit Function
  Do '起動を待つ
    DoEvents: Err = 0: AppActivate rt
  Loop While Err
  On Error GoTo 0
  hd = OpenProcess(PROCESS_ALL_ACCESS, False, rt)
  If hd = 0 Then kEWait2 = 1: Exit Function
  WaitForSingleObject hd, INFINITE '待機
  CloseHandle hd
End Function

'kEWait2関数のTEST
'電卓を起動し終了までExcelを待つ
Sub test_kEWait2()
  Dim ii&
  ii = kEWait2("CALC.EXE") '電卓を実行
  MsgBox IIf(ii, "異常終了しました Err=" & ii, "正常終了しました")
End Sub

追記： WshShellオブジェクトの利用
WshShellオブジェクトを用いると、他のプログラムを起動しそのプログラムが終了するまでVBAマクロを待機する事が出来ます。
但し、kEWait関数と違い、他のプログラム起動中もエクセルは操作出来ます。
WshShellオブジェクト(Wscript.Shell)
FileName　：wshom.ocx
Windows Scripting Host Runtime Library


'WScript.ShellのRunメソッドの使用例
'他のプログラムを起動し終了までVBAマクロを待機
Sub test_WScriptShellRun()
  Dim rt&
  rt = CreateObject("WScript.Shell").Run("CALC.EXE", , True)
  MsgBox "CALC.EXEが終了しました"
End Sub

項目

InputBoxで入力したセル範囲を得る関数

内容説明

InputBoxメソッドを用いてセル範囲を得るkInputSel関数を示します。
複数選択など、一般の数式入力と同様の範囲選択が出来ます。

'InputBoxで入力したセル範囲を得る関数
Function kInputSel() As Range 'InputBoxでセル範囲を入力する
    On Error Resume Next 'InputBoxの[キャンセル]キーを押すとエラーになるのでエラートラップを行う
    Set kInputSel = Application.InputBox(prompt:="セル範囲を選択してください。", _
        Title:="セル参照", Type:=8)
    On Error GoTo 0
End Function

Sub test_kInputSel() 'kInputSel関数で入力したセル範囲を表示するTEST
    Dim rg As Range
    Set rg = kInputSel
    If Not rg Is Nothing Then '[キャンセル]キーではない
        MsgBox rg.Address(external:=True) & " が選択されました。", , "セル参照"
    End If
End Sub

項目

印刷のページ数を得る関数

内容説明

Excelのシートを印刷するときのアクティブシートのページ数を得るkPageN関数を示します。

'kPageN関数　アクティブシートの印刷ページ数を得る
Function kPageN() 'アクティブシートの印刷ページ数を返す
  kPageN = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
End Function

'kPageN関数の使用例
Sub test_kPageN() 
    MsgBox ActiveSheet.Name & " 印刷ページ数=" & CStr(kPageN), , "印刷ページ数を調べる"
End Sub

指定したシ−トをアクティブにしないで印刷ページ数を得る関数を以下に示します。

'kPageNS関数　アクティブブックの指定シートの印刷ページ数を返す
'ws ワークシート(但しアクティブブックに限る)
Function kPageNS(Optional ByVal st As Worksheet) As Long
  If st Is Nothing Then Set st = ActiveSheet
  kPageNS = Application.ExecuteExcel4Macro( _
    "Get.Document(50,""" & st.Name & """)")
End Function

'kPageNS関数の使用例
Sub test_kPageNS()
  Debug.Print kPageNS(Worksheets("Sheet1"))
End Sub

'kPageNB関数　指定したブック・シートの印刷ページ数を返す
'ws ワークシート(アクティブブックでなくてもよい)
Function kPageNB(Optional ByVal st As Worksheet) As Long
  If st Is Nothing Then Set st = ActiveSheet
  If st.UsedRange.Address = "$A$1" And _
    IsEmpty(st.Range("$A$1").Value) Then Exit Function '最後のセル
  kPageNB = (st.HPageBreaks.Count + 1) * _
    (st.VPageBreaks.Count + 1) '横,縦の改ページ
End Function

'kPageNB関数の使用例
Sub test_kPageNB()
  Debug.Print kPageNB(Workbooks("Book2.xls").Worksheets("Sheet1"))
End Sub

項目

ユ−ザ−フォ−ムを画面の中央に表示させる

内容説明

ユ−ザ−フォ−ムを画面の中央に表示させるにはStartUpPositionプロパティを用います。以下に使用例を示します。
ダイアログフレームを画面の中央に表示させる方法は後述します。

'StartUpPositionプロパティ　UserFormを表示する位置を指定
'StartUpPositionに指定できる値
'Manual  　　　　0  初期設定値を指定しません。
'CenterOwner 　　1  UserFormが属する項目(Excel)の中央の位置。
'CenterScreen    2  画面全体の中央の位置。
'Windows Default 3  画面の左上隅の位置。
Sub a_E97M022() '画面の中央に表示
  With UserForm1
    .StartUpPosition = 2
    .Show
  End With
End Sub

Sub a_E97M022b() '指定した座標に表示
  With UserForm1
    .StartUpPosition = 0
    .Top = 50
    .Left = 100
    .Show
  End With
End Sub

ダイアログフレームを画面の中央に表示させるにはちょっと面倒です。VBAの通常命令ではユーザーが作成したダイアログフレームの表示位置を指定する事は出来ません。
Win32API を用いてダイアログフレームを画面の中央に表示する関数を示します。
以下のコードをモジュールシートにコピーしてお使い下さい。 Excel95/97対応です。

kDlgPosShow 関数はダイアログをCRT画面の中央、又は、Excelウインドウの中央に表示します。
ダイアログを表示するShowメソッドに代えてkDlgPosShow関数を用いて下さい。
最後の a_E97024関数はTEST用で、実際の運用には不要です。

'標準モジュール
Option Explicit
Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
  ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
  ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'ダイアログを画面の中央へ表示するkDlgPosShow関数
'引数 dlg:表示するダイアログ名
'     ww:0 Excelの中央へ表示。0以外又は省略 画面の中央へ表示
Sub kDlgPosShow(dlg$, Optional ww& = 1)
  pDlgPos2 ww
  On Error Resume Next
  DialogSheets(dlg).DialogFrame.OnAction = "pDlgPos1"
  If Err Then MsgBox Error(Err), vbExclamation, "kDlgPosShow": Exit Sub
  On Error GoTo 0
  DialogSheets(dlg).Show
End Sub

Private Sub pDlgPos1()
  Dim hwnd As Long, rc As RECT
  Const KK = 0.75
  hwnd = FindWindow("bosa_sdm_XL9", ActiveDialog.DialogFrame.Caption)
  If hwnd = 0 Then hwnd = FindWindow("bosa_sdm_XL8", ActiveDialog.DialogFrame.Caption)
  If hwnd = 0 Then Exit Sub
  Call GetWindowRect(hwnd, rc)
  If pDlgPos2 Then '画面の中央へ表示
    Call SetWindowPos(hwnd, 0, (GetSystemMetrics(0) - (rc.Right - rc.Left)) / 2, _
      (GetSystemMetrics(1) - (rc.Bottom - rc.Top)) / 2, 0, 0, 21)
  Else  'Excelの中央へ表示
    Call SetWindowPos(hwnd, 0, Application.Left / KK + (Application.Width / KK - (rc.Right - rc.Left)) / 2, _
      Application.Top / KK + (Application.Height / KK - (rc.Bottom - rc.Top)) / 2, 0, 0, 21)
  End If
  ActiveDialog.DialogFrame.OnAction = ""
End Sub
Private Function pDlgPos2(Optional ww&)
  Static op&
  If Not IsMissing(ww) Then op = ww
  pDlgPos2 = op
End Function

Sub a_E97024() 'ダイアログを画面の中央へ表示するTEST
  kDlgPosShow "Dialog1"
  MsgBox "ダイアログを画面の中央へ表示しました" & vbCrLf & "次はExcelの中央へ表示します", , "a_E97024"
  kDlgPosShow "Dialog1", 0 'Excelの中央へ表示
End Sub

ここに示したコードを利用すると、ダイアログの終了位置を覚えておいて前回の位置に表示する事なども出来ます。

注) Excel95までの[ダイアログ]からExcel97では[ユーザーフォーム]となりましたが、Excel97でも[ダイアログ]を用いる事は出来ます。新しい[ダイアログ]の挿入は[シート見出し]を右クリックし、[挿入]-[MS Excel5.0ダイアログ]を選択します。

項目

VBA 簡単にエラー処理を行うサンプル

内容説明

Excelでマクロを組む場合エラー処理の必要性は頻繁に発生します。
簡単なエラーの場合に、簡単に処理するルーチンを紹介します。
On Error Resume Next とOn Error GoTo xx を用いる場合を示しますが、On Error Resume Nextがお薦めです。
サンプルは、シート"aaa"へ移動、"aaa"がなければ"bbb"へ移動、"bbb"も無ければ"bbb"を作成 すると言うものです。これはエラー処理の手順を示すもので、サブルーチンの機能には意味がありません。

'簡単なエラー処理の方法
'シート"aaa"へ移動、"aaa"がなければ"bbb"へ移動、"bbb"も無ければ"bbb"を作成
Sub a_err1()
  Dim ff$(2)
  ff(1) = "aaa": ff(2) = "bbb"
  On Error Resume Next 'エラー処理ルーチンを有効にする
  Sheets(ff(1)).Select 'シート"aaa"へ移動
  If Err Then Err = 0: Sheets(ff(2)).Select 'エラーなので戻り値を0に設定し "bbb"へ移動
  If Err Then Sheets.Add.Name = ff(2)       'エラーなのでシ−トを作成
  On Error GoTo 0 'エラー処理ルーチンを無効にする
  '他の処理
End Sub

Sub a_err2() '
  Dim ff$(2), ii%
  ff(1) = "aaa": ff(2) = "bbb"
  ii = 1
  On Error GoTo er1 'エラー処理ルーチンを有効にする
  Sheets(ff(ii)).Select
  On Error GoTo 0 
  '他の処理
Exit Sub
er1:
  'If Err Then MsgBox Error(Err) + " Err=" + CStr(Err)'エラーメッセージとエラー番号を表示
  If ii = 1 Then ii = ii + 1: Resume 'エラーが発生した行から再開
  Sheets.Add.Name = ff(ii)
  Resume Next 'エラー発生の次の行へ
End Sub