K窓 Excel技<Excel Tips> Excel編

E02M100(Excel2002)

項目

非表示でブックを開く

内容説明

'非表示でブックを開く
Sub test_OpenInvisibility()
  Dim wb As Workbook
  Application.ScreenUpdating = False
  Set wb = GetObject("c:\ddd\eee\book1.xls")
  Application.ScreenUpdating = True
  'wbに対してデータ取得処理
  '
  wb.Close False
End Sub

E02M099(Excel2002)

項目

UserFormに現在時刻を表示する

内容説明

'標準モジュ－ル
'kPresentTimeUserForm関数 UserForm上に現在時刻を表示する
'引数 uf：UserForm  ctl:表示するコントロール　fmt：表示フォーマット
'使用例: UserFormにLabel1を準備しActivateイベントで次行を記述
'　kPresentTimeUserForm Me, Label1
Sub kPresentTimeUserForm(uf As Object, ctl As Object, Optional fmt$ = "yyyy/mm/dd hh:mm:ss")
  pPresentOnTime uf, ctl, fmt
End Sub

Private Sub pPresentOnTime(Optional uf0 As Object, Optional ctl0 As Object, Optional fmt0$)
  Static uf As Object, ctl As Object, fmt$
  If Not uf0 Is Nothing Then
    Set uf = uf0: Set ctl = ctl0: fmt = fmt0
  End If
  If TypeName(uf) = "UserForm" Then
    Set uf = Nothing: Set ctl = Nothing: fmt = ""
    Exit Sub
  End If
  If ctl Is Nothing Then Exit Sub
  ctl = Format(Now, fmt)
  Application.OnTime Now + TimeValue("00:00:01"), "pPresentOnTime"
End Sub

'フォ－ムモジュ－ル
Private Sub UserForm_Activate()
  'kPresentTimeUserForm関数の使用例 Label1を配置
  kPresentTimeUserForm Me, Label1, "yyyy/mm/dd(aaa) hh:mm:ss"
End Sub

E02M098(Excel2002)

項目

ファイルが開かれているかを簡潔に調べる

内容説明

ファイルが既に開かれるかどうかチェックするマクロコード

'kIsFileOpen関数
'ファイルが開かれているかを簡潔に調べる
'引数 fn$：ファイルのフル名
'戻り値  True
Function kIsFileOpen(fn$) As Boolean
  On Error Resume Next
  If Dir(fn, vbHidden Or vbReadOnly Or vbSystem) = "" Then Exit Function
  If Err Then Exit Function
  CreateObject("Scripting.FileSystemObject").MoveFile fn, fn
  If Err Then kIsFileOpen = True
End Function

'kIsFileOpen関数の使用例
Sub test_kIsFileOpen()
  Dim fn$
  fn = "\\aaa\bbb\ccc\ddd.xls"
  If kIsFileOpen(fn) Then
    MsgBox "ファイルは既に開かれています" & vbCrLf & "閉じてから実行してください"
  Else
    'Workbooks.Open fn
  End If
End Sub

E02M097(Excel2002)

項目

任意の名前の新規ブック作成

内容説明

'kWorkbookAddName関数
'任意の名前の新規ブック作成
'引数   na$：新規作成するブックの名前
'       nn&：シート数 省略可能。既定値は1
'戻り値 新規作成したWorkbookオブジェクト
Function kWorkbookAddName(na$, Optional nn& = 1) As Workbook
  Dim tmp$, nb&
  tmp = Environ("temp") & "\" & na & ".xls"
  If Dir(tmp, vbHidden Or vbReadOnly Or vbSystem) <> "" Then Kill tmp
  nb = Application.SheetsInNewWorkbook
  Application.SheetsInNewWorkbook = nn
  Application.ScreenUpdating = False
  With Workbooks.Add(IIf(nn = 1, xlWBATWorksheet, 5))
    .SaveAs tmp
    .Close
  End With
  Application.ScreenUpdating = True
  Application.SheetsInNewWorkbook = nb
  Set kWorkbookAddName = Workbooks.Add(tmp)
  Kill tmp
End Function

'kWorkbookAddName関数の使用例
Sub test_kWorkbookAddName()
  Dim wb As Workbook
  Set wb = kWorkbookAddName("Test") ', 3)
  '
End Sub

追記：

Workbooks.Add 6

E00M096(Excel2002)

項目

異なるバージョンでの共存

内容説明

'■Excel2000～2007で利用するファイル保存
Excel2007でSaveAsメソッドで保存した場合Excel2000～2003では開くことが出来なくなります。(Excel2007形式(xlsx等)で保存されるため)
自動で互換モードで保存させる例を示します。

'互換モードで名前を付けて保存 for Excel2000-2007
Sub test_SaveAsExcel8()
  Dim Wb As Workbook, Filename$
  Set Wb = ActiveWorkbook
  Filename = "c:\ddd\eee\fff.xls"
  Application.DisplayAlerts = False
  Wb.SaveAs Filename, xlWorkbookNormal
  Application.DisplayAlerts = True
End Sub

'■Excel2000とExcel2002以降のバージョンで処理を別ける例(CallByName関数を利用)
'行の挿入時に挿入行の下にある行の書式を適用
Sub test_RowInsert()
  With Range("a3")
    If Val(Application.Version) >= 10 Then
      CallByName .EntireRow, "Insert", VbMethod, xlShiftDown, 1 '値リテラルを使用 xlFormatFromRightOrBelow
    Else
      With .EntireRow
        .Insert xlShiftDown
        .Item(1).Copy
        .Offset(-.Count).PasteSpecial xlPasteFormats
      End With
      Application.CutCopyMode = True
    End If
  End With
End Sub

'■CommandBarsのExcel2002より追加されたプロパティ操作(CallByName関数を利用)
Sub test_DisableCommandBarItem()
  If Val(Application.Version) >= 10 Then
　　'ツールバーのユーザー設定を無効にする
    CallByName Application.CommandBars, "DisableCustomize", VbLet, True
　　'アンサー ウィザードのドロップダウンメニューを無効にする
    CallByName Application.CommandBars, "DisableAskAQuestionDropdown", VbLet, True
  End If
End Sub

'■Excel2002より追加された引数の処理(実行時バインディングによる方法)
Sub test_ProtectNewArgument()
  Dim st As Object
  Set st = ActiveSheet 'Object変数へ代入(コンパイル時引数のチェックがされない)
  If Val(Application.Version) >= 10 Then '2002以降
    st.Protect AllowFormattingCells:=True
  Else
    st.Protect
  End If
End Sub

'■Excel97とExcel2000以降のバージョンで処理を分ける例
'条件付きコンパイルによる方法
Sub test1_UserFormShow()
  #If VBA6 Then
    UserForm1.Show vbModeless
  #Else
    UserForm1.Show
  #End If
End Sub

'実行時バインディングによる方法
Sub test2_UserFormShow()
  Dim fm As Object
  Set fm = UserForm1 'Object変数へ代入
  Select Case Val(Application.Version)
  Case 8
    fm.Show
  Case Is >= 9
    fm.Show 0 'vbModeless
  End Select
End Sub

追記：Excel97のUserFormで擬似モードレスにする例
'標準モジュール
Declare Function EnableWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal bEnable As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub kUserFormModeless()
  EnableWindow FindWindow("XLMAIN", Application.Caption), True
End Sub

'UserFormモジュール
Private Sub UserForm_Activate()
  If Val(Application.Version) < 9 Then kUserFormModeless
End Sub

E00M095(Excel2002)

項目

セルの値や書式を変更するユーザー関数？

内容説明

エクセルテクニック集 kVBA3 ユーザー関数編

kVBA3(書式を変更するユーザー関数)の使用例です。
まず、kVBA3をインストールしておきます。

例1：数値の小数点の位置を揃えて表示
有効桁数3で小数点の位置を揃えます。値の変更に伴い小数点の位置を揃えてくれます。

セルE1:E6に以下のサンプルデータを入力
      E      F
1 　 合計
2    1.56
3    0.975
4   25.6
5   85.3
6  105.36

セルE1に下記式を入力　
=kPointArrange("合計",E2:E6,3)

例2：連続した番号付けを行う
指定した列のセル範囲を1,2,3...と番号付けをします。

標準モジュールに以下を記述
'kSpecified関数の処理関数例
'番号付けを行う
'rg:設定範囲
Sub kNumbering(ByVal rg As Range)
  Dim va, ii&
  Set rg = rg.Offset(1).Resize(rg.Rows.Count - 1)
  va = rg
  For ii = 1 To UBound(va)
    va(ii, 1) = ii
  Next
  rg = va
End Sub

セルA1に下記式を入力　
=kSpecified("No",A1:A100,"kNumbering")

次のようにA列に番号付けが行われます。
      A      B
1 　 No
2     1
3     2
4     3
.     .
100  99

注： kVBA3はシェアウェアですが制限なく全ての組込みユーザー関数の試用が出来ます。
ライセンス取得されますとkVBA3のソースコード(モジュール)を提供致します。モジュールをプログラムに直接組み込む事でkVBA3のインストール無しで提供関数がご利用頂けます。

書式を変更するユーザー関数の実装例
kVBA3を用いずセルの書式(プロパティ)を変更することの出来るユーザー関数をいくつか紹介します。

'kCommentText関数
'コメントの文字列を設定する
'引数 Value：自身の値
'　　 He　 ：設定するセル 注)コメントは任意の書式で作成済みの事
'　　 Text ：コメントの文字列
Function kCommentText(Value As Variant, He As Range, Text As String)
  If He.Comment Is Nothing Then　He.AddComment
  He.Comment.Text Text
  kCommentText = Value
End Function

'kCommentTextA関数　↑上記kCommentText関数の応用
'作業用セルに記述して指定セルの値を指定セルにコメントの値として設定する
'注)コメントは任意の書式で作成済みの事
'引数 sur ：コメントを設定するセル
'　　 dis ：コメントのセル surと同じセル範囲の事
'     va  ：自身の値
Function kCommentTextA(sur As Range, dis As Range, Optional va As Variant = "")
  Dim ii&
  For ii = 1 To sur.Count
    If dis(ii).Comment Is Nothing Then dis(ii).AddComment
    dis(ii).Comment.Text sur(ii).Value
  Next
  kCommentTextA = va
End Function

'kHeText関数
'セルへ文字列を書き込む
'引数 Value：自身の値
'　　 He　 ：設定するセル
'　　 Text ：書き込む文字列
Function kHeText(Value As Variant, He As Range, Text As String)
  With ActiveSheet.Hyperlinks.Add(Anchor:=He, Address:="", TextToDisplay:=Text)
    .Delete
  End With
  kHeText = Value
End Function

E00M094(Excel2002)

項目

セル編集中はマクロが実行出来ない？

内容説明

'標準モジュール
Private Declare Function SetTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Function pUnderEditProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
  KillTimer 0, idEvent
  If Application.CommandBars.FindControl(ID:=18).Enabled Then _
    MsgBox "5秒経過しました" Else MsgBox "セル編集中です"
End Function

'セル編集中にマクロを実行するテスト
Sub test_UnderEdit()
  SetTimer 0, 0, 5000, AddressOf pUnderEditProc
End Sub

追記1

エクセル入力支援[k蘭]

追記2：セル編集中はコマンドバーを使用不可にするサンプル
作成したコマンドバーはセル編集中にクリックしてもコマンド(マクロ)は実行されません。ユーザーから見ればクリックしても実行されないとクレームになります。
そこでセル編集中はコマンドボタンを淡色表示にして視覚的に使用不可を示します。

'標準モジュール
Option Explicit
Dim dce As CDisableUnderEdit

Sub testDisableUnderEditAdd() 'コマンドバー作成
  Set dce = New CDisableUnderEdit
  dce.CellEditAdd
End Sub

Sub testDisableUnderEditDel() 'コマンドバー削除
  dce.CellEditDel
  Set dce = Nothing
End Sub

'クラスモジュール　CDisableUnderEdit
Option Explicit
Public WithEvents Menu As Office.CommandBarButton
Dim dmenu As New Collection
Const dTIT = "セル編集中は使用不可" 

Sub CellEditAdd()
  Dim cb As CommandBar
  CellEditDel
  Set cb = CommandBars.Add(Name:=dTIT, Temporary:=True)
  With cb 'CommandBars.Add(Name:=dTIT, temporary:=True)
    With .Controls.Add(ID:=18)
      .Caption = "xxx(&X)"
      .FaceId = 481
    End With
    With .Controls.Add(ID:=18) 'セル編集中は使用不可になるIDを指定
      .Caption = "yyy(&Y)"
      .FaceId = 483
    End With
    .Visible = True
  End With
  SetMenuEvents cb
End Sub

Sub CellEditDel()
  On Error Resume Next
  Dim ii&
  For ii = 1 To dmenu.Count: dmenu.Remove 1: Next
  CommandBars(dTIT).Delete
End Sub

'イベント処理
Private Sub Menu_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  Application.EnableEvents = False
  CancelDefault = True
  Select Case Ctrl.Caption
  Case "xxx(&X)"
    MsgBox Ctrl.Caption
  Case "yyy(&Y)"
    MsgBox Ctrl.Caption
  Case Else
    CancelDefault = False
  End Select
  Application.EnableEvents = True
End Sub

'MenuEvents設定 再帰
Private Sub SetMenuEvents(cb As Object)
  Dim cb2 As CommandBarControl
  For Each cb2 In cb.Controls
    If cb2.Type = msoControlButton Then
      Set Menu = cb2
      dmenu.Add Me
    End If
    If cb2.Type = msoControlPopup Then SetMenuEvents cb2 '再帰
  Next
End Sub

E00M093(Excel2002)

項目

エクセルとお呪い

内容説明

VBEのプロパティ操作でフリーズ
UserFormのプロパティ操作でVBEウィンドウが固まって操作出来なくなる事があります。
呪文：タスクバーのエクセルのボタンを右クリックで復活します。
浮動小数点数値演算の誤差
以下MSのページに演算の誤差に付いて記述されていますが、対処方法は分からないのか書かれていません。
小数を使用した計算の誤差について
例えばExcel2000で 0.5-0.4-0.1 を計算した場合 -2.77555756156289E-17 となる。(正解は0)
また、Round関数などでも Round(4.025, 2) は 4.03 となる。(正解は4.02)
呪文：最も簡単なのはデータ型変換関数 CCur(通貨型Currency)を使います。セルへ代入する場合は表示が通貨型となるのを防ぐためVal関数を併用します。
```
Sub test_ErrorCalculation()
  Debug.Print 0.5 - 0.4 - 0.1
  Debug.Print CCur(0.5 - 0.4 - 0.1)
  Debug.Print Round(4.025, 2)
  Debug.Print Round(CCur(4.025), 2)
  Range("a1").Value = Val(CCur(0.5 - 0.4 - 0.1)) 'セルへ代入
End Sub
```
CodeNameプロパティが取得出来ない
Addメソッドで新しいワークシートを作成後、CodeNameプロパティが取得出来なくなります。
オブジェクトのコード名を取得する次の例はVBEを一度も開いていない場合は失敗します。(エラーにはならないがコード名は取得出来ない)
Sub test1_GetCodeName()
　Sheets.Add
　MsgBox ActiveSheet.CodeName
End Sub
呪文：CodeNameプロパティの直前行で With Application.VBE: End With とします。
WWith ActiveWorkbook.VBProject: End With や Application.VBE.MainWindow.Visible = False 等でもOKでVBEへ接続してやれば良い様です。
```
Sub test2_GetCodeName()
  Worksheets.Add
  'VBEを一度も開かなくてもCodeNameを取得するお呪い
  With Application.VBE: End With
  MsgBox ActiveSheet.CodeName
End Sub

'シート名とコード名を変更(同名)する例
Sub test3_GetCodeName()
  Dim ws As Worksheet
  Const SN = "Sheet0"
  If Not IsError(Evaluate(SN & "!a1")) Then Beep: Exit Sub '同名シートが既に存在
  Set ws = Worksheets.Add
  With ws
    .Name = SN
    With Application.VBE: End With 'お呪い
    .[_CodeName] = .Name
  End With
End Sub
```
GetOpenFilenameメソッドでMultiSelectが出来ない
GetOpenFilenameメソッドで引数MultiSelectが有効にならず1つのファイルしか選択できない現象です。
呪文：原因はActiveSheetに条件付書式を使っている事のようです。
対策は、ActiveSheetを条件付書式を使っていないシートに切り替えてGetOpenFilenameメソッドを実行し、実行後元のシートに戻すことです。
Windows2000&Excel2000の環境で不都合を確認しています。
バージョン(Ver,SR,SP)によっては正常動作するように治っていますが、配布ファイルであれば対策をとっておいたほうがいいでしょう。
シートのActiveXコントロールが正常に表示されない
ファイルを開いたときシートに配置したActiveXコントロールがデザインしたサイズにならず矩形状態で表示されます。
FormsコントロールはOKですが、他のコントロール(DTPicker、ListView、TreeView、ProgressBar等)で不都合が起こります。
対処としてはシートの再描画を行えば良いようです。
呪文：Openイベントに以下を記述します。(再描画であれば何でも良い)
```
Private Sub Workbook_Open()
  ActiveWindow.SmallScroll 1 'シートの再描画のお呪い
  ActiveWindow.SmallScroll -1
End Sub
```
1度目のクリックでOptionButtonが動作しない
UserFormにて複数のOptionButtonにControlSourceプロパティを設定している場合、OptionButtonをクリックしても1度目は反応しなくて2度目から反応します。
呪文：1度目から動作させるにはInitializeイベントに以下を記述します。
```
Private Sub UserForm_Initialize()
  'OptionButtonにControlSourceプロパティ設定時のお呪い
  Application.Calculation = xlAutomatic
End Sub
```
ファイルに埋め込まれるあなたの名前
エクセルファイルを開くだけで(保存などしなくても)あなたの名前(UserNameプロパティ)がファイルに埋め込まれているのをご存知ですか。
一般エクセルファイルを閲覧して閉じた後、エディタで開きユーザー名(UserNameプロパティ)を検索してみて下さい。
呪文：ファイルを[読み取り専用]にしておきます。
Excel97の有名なお呪い
コントロールツールボックスのコマンドボタンを押してマクロを実行するとエラーが発生する。
呪文：マクロの始めに ActiveCell.Activate を記述しフォーカスをセルに戻します。又は、コマンドボタンのTakeFocusOnClickプロパティをFalseにしてフォーカスがボタンに移らないようにします。
[入力規則]-[リスト]でSheetChangeやChangeイベントが発生しない。
呪文：[元の値]でセル参照をしないで数式を直接入力します。例： aaa,bbb,ccc,ddd

E00M092(Excel2002)

項目

FileSystemObjectの便利メモ

内容説明

参照設定

FileSystemObjectの宣言例

Sub FileSystemObject宣言例1() '参照設定: Microsoft Scripting Runtime
  Dim fso As New FileSystemObject
  MsgBox fso.GetTempName
End Sub
Sub FileSystemObject宣言例2()
  Dim fso As Object 'FileSystemObject
  Dim rt As Long
  Set fso = CreateObject("Scripting.FileSystemObject")
  rt = fso.GetFolder("c:\").Files.Count
  MsgBox "ファイルは " & rt & " 個有ります"
End Sub
Sub FileSystemObject宣言例3()
  Dim rt As Long
  With CreateObject("Scripting.FileSystemObject")
    rt = .GetFolder("c:\").SubFolders.Count
    MsgBox "フォルダは " & rt & " 個有ります"
  End With
End Sub

FileSystemObjectの使用例

'ファイルの存在を調べる
Sub test_FileExists()
  Dim file$
  file = "c:\ddd\eee\fff.xls"
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(file) Then MsgBox file & vbCrLf & "存在しています"
  End With
End Sub

'テキストファイル作成&ファイルサイズ取得
Sub test_CreateTextFile()
  Dim ff$, ss$
  ff = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
    & "\test1.txt"
  ss = "aaaaa" & vbCrLf & "bbbbb" & vbCrLf & "ccccc"
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(ff, True) '上書きで作成
      .Write ss '書き込み
      .Close
    End With
    With .GetFile(ff)
      MsgBox .Name & "のサイズは" & .Size & "バイトです"
    End With
  End With
End Sub

'フォルダをコピー
Sub test_CopyFolder()
  Dim f1$, f2$
  f1 = "C:\ddd\eee"
  f2 = "C:\ddd\eee2"
  With CreateObject("Scripting.FileSystemObject")
    .CopyFolder f1, f2, False 'False:上書きはしない True:上書き
    '.CopyFile Source, Destination, True 'ファイルコピー
  End With
End Sub

'ファイルのタイプスタンプ取得
Sub test_GetFile() '参照設定: Microsoft Scripting Runtime
  Dim fso As New Scripting.FileSystemObject
  Dim file$
  file = "C:\ddd\eee\Book1.xls"
  With fso.GetFile(file)
    Debug.Print "ファイル名", .Name, .ShortPath
    Debug.Print "種類", .Type
    Debug.Print "作成日", .DateCreated
    Debug.Print "更新日", .DateLastModified
    Debug.Print "アクセス日", .DateLastAccessed
  End With
End Sub

'ドライブの容量取得
Sub test_GetDrive()
  Dim drive$
  drive = "c"
  With CreateObject("Scripting.FileSystemObject")
    With .GetDrive(.GetDriveName(.GetAbsolutePathName(drive)))
      If .IsReady Then
        Debug.Print "ドライブ ", .DriveLetter
        Debug.Print "合計サイズ", Format(.TotalSize / 1024, "#,###"); " KB"
        Debug.Print "使用可能な容量", Format(.AvailableSpace / 1024, "#,###"); " KB"
      End If
    End With
  End With
End Sub

'CDRomドライブを取得
Sub test_Drives() '参照設定: Microsoft Scripting Runtime
  Dim fso As New FileSystemObject
  Dim drv As drive
  Dim cc As New Collection, cd
  For Each drv In fso.Drives
    'Debug.Print drv.DriveLetter; ": "; drv.DriveType
    If drv.DriveType = CDRom Then '4
      cc.Add drv.DriveLetter
    End If
  Next
  Debug.Print cc.Count; "つのCDRomドライブがあります"
  For Each cd In cc
    Debug.Print cd
  Next
End Sub

'テキストファイルの行数取得
Sub test_Line() '参照設定: Microsoft Scripting Runtime
  Dim fso As New Scripting.FileSystemObject
  Dim file$
  file = "C:\Documents and Settings\kawaguchi\デスクトップ\test1.txt"
  With fso.OpenTextFile(Filename:=file, IOMode:=ForAppending)
    Debug.Print "行数="; .Line; file
  End With
End Sub

追記：FileSystemObjectの資料・ヘルプ
MSDNのWebSite
FileSystemObjectのオブジェクト
メソッドとプロパティの一覧

Micresoft Visual Basic のヘルプ([VBE]-[ヘルプ]-[Micresoft Visual Basic ヘルプ])
[質問]タブで FileSystemObject で検索

VBLR6.CHM - Visual Basic Reference
"C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\1041\VBLR6.CHM"
[目次]-[オブジェクト]-[FileSystemObject]とたどる

FileSystemObjectの自動メンバー表示をするには
[Microsoft Scripting Runtime]に加え[Microsoft Scriptlet Library]を参照設定する。
一度自動メンバー表示が出来るようになったら[Microsoft Scriptlet Library]の参照設定は外してもよい。

E00M091(Excel2002)

項目

UserFormの[×]をクリックしたとき[キャンセル]ボタンを押したことにしたい

内容説明

'UserFormモジュール
'Cancel(終了)ボタン(CommandButton名->cmdCancel)が配置されている例

Private Sub cmdCancel_Click()
  MsgBox "cmdCancel_Click" 'ボタンが押された確認用
  '終了時の処理を記述
  '
  Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  'vbFormCode 1 コードからUnloadステートメントが実行された
  If CloseMode <> vbFormCode Then cmdCancel.Value = True '[×]がクリックされた
End Sub

1997/4/1 初版

Excel技<Excel Tips>－マクロ