この処理を行わせるにはＶＢＡによるコーディングが、わずかですが必要になります。つまり行挿入を自動実行させるわけです。
ここではデータが縦に複数行入力されている場合に、あとから６行ごとに１行の空欄を挿入する場合（１行目には見出し項目があるとする）で説明します。

まずＥｘｃｅｌにコードを書き込むために、次の手順でコードウィンドウを開きます。
1）左手で「Ａｌｔ」キーを押した状態で、右手でキーボード右斜め上の「Ｆ11」キーを押します。
2）するとＶｉｓｕａｌ Ｂａｓｉｃ Ｅｄｉｔｏｒが起動してＥｘｃｅｌとは別の画面が表示されます。
3）上部のメニューバーから「挿入」→「標準モジュール」と選択して、「Ｍｏｄｕｌｅ1」というコードを書き込むための領域を表示させます。
4）同様に上部のメニューバーから「挿入」→「プロシージャ」と選択して、これから記述するコードのかたまりに名前を付けます。
5）どんな名前でもよいですから適当な名前をプロシージャ名として登録します。その際半角文字でも全角文字でもかまいません。覚えやすい名前を付けて下さい。
6）それが終わったらそのままＯＫボタンを押してウィンドウを閉じます。するとPublic Sub xxx( )からEnd Subまでの空欄が自動的に作成されます。
7）そうしたらこの間の領域に以下のコードを記入します。

Do While ActiveCell.Offset(7, 0).Value <> ""
　　ActiveCell.Offset(7, 0).Rows("1:1").EntireRow.Select
　　Selection.Insert Shift:=xlDown
Loop

8）記入が終わったら、画面左上にＥｘｃｅｌのアイコンボタンがありますので、それを押してＥｘｃｅｌの画面に戻ります。
9）１行目から行数をカウントさせるために、セルのＡ1を予めクリックして選択しておきます。
10）上部のメニューバーから「ツール」→「マクロ」→「マクロ」と選択して、コードを実行するウィンドウを開きます。
11）さきほど名前を付けたコードをリストから選択して、実行ボタンを押します。
12）すると自動的に６行おきに空欄が挿入されていき、データが切れたところで終了します。

【解説】
「Do While ActiveCell.Offset(7, 0).Value <> ""」と「Loop」は繰り返し同じ動作を実行させる時必要となる命令です。繰り返しを終わらせる条件として、「現在挿入を実行している行から７番目下方のＡ列のセルにデータが入ってない状態になるまで処理を繰り返せ」という意味になります。
ActiveCell.Offset(7, 0).Rows("1:1").EntireRow.Selectは現在処理中の行から７番目下方の行を１行まるごと選択させる命令です。
Selection.Insert Shift:=xlDownで行の挿入を行わせています。

実のところ、行の選択と挿入の命令は特に知らなくても、「マクロ記録」という機能を使えば実際にワークシート上でやらせたい操作を行い、それを自動記録させることでコードを確認することができます。
プログラミングの知識が必要な部分は同じ処理を繰り返し行わせる部分だけですので、書店などでＶＢＡの関連図書を覗いてみてください。
今はVBAについて詳しく説明された本が多数出ていますので、自分のレベルにあったものを探すことが出来ればすぐに理解できるでしょう。
興味のある方は勉強してみてください。

複数行にデータが入力されているとき、途中の空白行のみを削除したいときがあります。
数が少なければ一つ一つ手作業で削除していってもたいしたことはありませんが、件数が1000件を超えるような作業だと かなりの手間となってしまいます。
こんなとき10行程度のVBAコードを書くことで、大幅に作業時間を短縮させることが出来ます。
ここではＡ列に飛び飛びにデータが入力されているものとします。
まず「Alt」+「F11」でVBEを起動し標準モジュールを挿入した上で、以下のコードを記入してください。プロシージャの名前は任意に決めてもらって結構です。

Sub sakujo()
Dim i As Long
Dim y As Long

Cells(65536, 1).Select
Selection.End(xlUp).Select
y = ActiveCell.Row

For i = y To 1 Step -1
   If Cells(i, 1) = "" Then
      Cells(i, 1).Delete Shift:=xlUp
   End If
Next
End Sub

データの並べ替えや抽出などを行うとき、画面がちらついたり処理の実行過程がすべて見えてしまうことがあります。 そのため処理のスピードも落ちてしまいます。
そんなとき次のコードを処理の先頭に入れておくと、結果のみが画面に表示されることになり、速度も向上します。

Application.ScreenUpdating=False '画面更新の抑制

処理が終わったら必ず処理の最後に次のコードも入れてください。

Application.ScreenUpdating=True '抑制の解除

VBAでコードを記述して実行をして見ると、思った通りの動作にならないことがよくあります。
論理エラーと呼ばれるもので、処理のアルゴリズム（問題解決手順）に誤りがある場合に発生します。
文法エラーの場合はコードを記述した時点で、システムが教えてくれることが多いのですが、論理エラーは自分で探し、解決するしかありません。
短いコードであれば、うまく動作しない部分をよく見て処理の動きを追いかけることで、すぐに見つかる場合が多いのですが、長いプログラムや短くても内部の処理がわからない場合は、 誤りを見つけるのに非常に苦労します。

そんなときデバッグの方法をいくつか知っていると、とても重宝します。
1つはブレークポイントを活用することです。ブレークポイントはプログラムの実行途中で処理を止めて、その時点での動作結果を確認する場合に使います。
VBAエディタが開いている画面で、調べたいコード上にカーソルを置き、メニューバーの「デバッグ」→「ブレークポイントの設定/解除」で行えます。（直接コードウィンドウの左端をクリックしても行えます）
この状態でコードを実行すると、必ずブレークポイントを設定した場所でいったん処理がストップするので、止まったら変数の内容を調べたり（カーソルを変数の上に置くと、内容が表示されます）、画面上の結果を確認したり出来ます。

2つめはイミディエイトウィンドウを利用することです。
イミディエイトウィンドウはメニューバーの「表示」→「イミディエイトウィンドウ」で表示させることができます。このウィンドウに変数の内容等の履歴を書き出すことができるので、内部のデータの変化を連続して確認する時に重宝します。
イミディエイトウィンドウに出力する方法は、通常Debug.Print 変数名という書き方で、この命令をコードの好きな場所に埋め込みます。コードを実行した時に、この命令が実行されると、変数の中身がイミディエイトウィンドウに書き出されますので、実行途中や実行後に確認することが出来ます。

次の例はDo　While　のループ処理で、ループ1回ごとに変数c,i,jの内容をイミディエイトウィンドウに書き出しています。

c = 0
Randomize
Do While c < 30
    i = Int(Rnd * 10 + 3)
    j = Int(Rnd * 9 + 2)
    With Cells(i, j)
        If .Value <> "★" Then
             .Value = "★"
             .Font.ColorIndex = 34
            c = c + 1
            Debug.Print c, i, j          'デバッグ箇所
        End If
    End With
Loop
		

ゲームなどでランダムな数を発生させ、それを利用したいと思ったことはありませんか？
VBAでは乱数を発生させる関数（Rnd関数）があり、これを利用すれば簡単に乱数を取り出すことが出来ます。

書式は「C = Int((Rnd * B) + A)」となります。
Cは任意の変数で、あらかじめ整数型でプロシージャの先頭で宣言しておきます。
A、Bはなくてもよいのですが、必要なときに数値を指定します。
Rnd命令で0より大きく1より小さい数がランダムに取り出せます。この数を直接利用してもかまいませんが、通常は0から9までの任意の数だとか 1から99までの任意の数だとか整数型で利用する場合が多いと思います。

そんなときInt()関数を用いて小数点以下の数を整数に変換します。0から9までの整数であれば、「変数=Int(Rnd*10)」となります。
今の数を1だけシフトさせたければ「変数=Int((Rnd*10)+1)」とします。これで1から10までの数が取り出せます。
しかし困ったことに、この乱数もRnd命令を記述したプロシージャを毎回呼び出すと、決まったパターンの数値が現れてしまうことがあります。
そこでRnd命令の前にRandomizeステートメントを置くことで、同一パターンの発生を防ぐことが出来ます。

Randomize
kazu=Int((Rnd*10)+1)

これは実行時の時刻をもとにして、乱数計算のシードを変化させることで実現しています。

１つのセルに生年月日や住所などが入っており、それを別々のセルへ分割して格納したいときがあります。
そういう場合はSplit関数を知っていると便利です。

※年月日は先頭にシングルクォーテーション(')をつけて文字列にしてあります

Split関数は、区切られた文字列から配列を作成して結果を返す関数です。
書式はSplit(対象文字列,区切り文字)となります。
区切り文字はダブルクォーテーション("")で囲みます。

サンプルを2つ挙げておきます。どちらも動作はまったく一緒です。



データが大量にある場合に威力を発揮します。ぜひ試してみてください。

テキストファイルの内容を標準モジュールに挿入することができます。
1）モジュールを開き、テキストファイルを挿入したい位置にカーソルを置きます。
2）メニューバーから「挿入」→「ファイル」→「テキストファイルの読み込み」ダイアログボックスでファイル名を選択し、「開く」ボタンを押します。
3）テキストファイルの内容（コード）がインポートされます。

Worksheetを削除したり、内容を更新してBookを閉じたりするときには必ずシステムの方から確認のメッセージが 表示されます。
これがわずらわしかったり不必要と思う場面では、メッセージを出させないようにすることもできます。
処理の前に次のコードを入れてください。

Application.DisplayAlerts=False '警告メッセージの抑制

処理が終わったら念のため処理の最後に次のコードも入れてください。

Application.DisplayAlerts=True '抑制の解除

プロシージャの処理の途中で別のBookを開いて内容を参照したいときがある場合はWorkbooks.Open命令を使います。

書式はWorkbooks.Open Filename:="ファイル名"となっていますが、単純にファイル名だけを指定しても「○○○が見つかりません。 ファイル名およびファイルの保存場所が正しいかどうか確認してください。」というメッセージが返ってきてしまいます。

これはそのまま指定すると、システムはExcelそのものがインストールされている場所を探しに行くためで、カレントディレクトリがWorkbookが保存されてる場所と異なるために発生します。

したがって目的のファイルを開くには、まず開きたいWorkbookのパスを取得する必要があります。
ここではVBAがかかれているBookと今から開こうとしているBookが同じフォルダに存在する場合のコーディング例を示します。

Dim fName As String
Dim book As Workbook

Set book = Application.ActiveWorkbook

'現在のPathとファイル名を連結
fName = book.Path & "\○○○.xls"

'目的のファイルを開く
Workbooks.Open Filename:=fName

ここでファイル名の前に￥を付けることを忘れないでください。

データ数が多くて、集計処理に時間がかかるとき、例えばFOR〜NEXT文などで処理をループさせている場合は 結果が出るまでにかなり時間がかかってしまう場合があります。
そのようなとき、Excelに備わっているワークシート関数を利用することで、思わぬ速度向上が実現できる場合があります。

処理をループさせて計算している例

Public Sub plus1() Dim c As Range Dim tmp As Long tmp = 0 For Each c In Range("A1:A10000") tmp = tmp + c.Value Next c Cells(1, 2).Value = tmp End Sub

ワークシート関数のSUM関数を利用している例

Public Sub plus2() Dim tmp As Long tmp = Application.Sum(Range("A1:A10000")) Cells(1, 3).Value = tmp End Sub

このようにプログラム中にワークシート関数が利用できる場合は、既存の関数に計算を任せたほうが正確で安全に処理を行わせることできます。
ただしこの程度のサンプルコードでは大して差はありません。もっと良い例をお見せできればよかったんですが・・・。

たいていのアプリケーションが利用している、ファイルを開く際のダイアログボックスを利用して、ファイル名を取得する場合はGetOpenFilename() メソッドを使うことで実現できます。
以下はテキストファイル名（パス情報）を取得し、従来のOpen命令でファイルを開いて処理する例をあげています。
なお、キャンセルボタンが押されたときの処理も記述しておかないと、「開く」「キャンセル」どちらのボタンが押されても以下の処理が実行されてしまいます。

Public Sub ReadText() Dim FileNumber As Integer Dim TextLine As String Dim myFile As String Dim i As Integer '「ファイルを開く」ダイアログ表示 myFile = Application.GetOpenFilename("テキストファイル,*.txt") 'キャンセルボタンが押されたとき If StrConv(myFile, vbUpperCase) = "FALSE" Then MsgBox "キャンセルされました。" Exit Sub End If 'テキストファイルを入力モードでOPEN FileNumber = FreeFile Open myFile For Input Access Read As #FileNumber 'テキストデータをA列へ順に格納 i = 1 Do While Not EOF(FileNumber) Line Input #FileNumber, TextLine Cells(i, 1).Value = TextLine i = i + 1 Loop Close #FileNumber End Sub Public Function CallOpenDialogue() As String 'Function関数の戻り値として取得 Dim myFile As String Dim FileType As String Dim Title As String FileType = "画像ファイル,*.jpg;*.gif;*.bmp" Title = "画像ファイルを選択してください。" myFile = Application.GetOpenFilename(FileType, , Title) If StrConv(myFile, vbUpperCase) = "FALSE" Then Title = "「ファイルを開く」操作をキャンセル" MsgBox "キャンセルされました。", vbInformation, Title Exit Function End If CallOpenDialogue = myFile End Function

引数の数が不定の場合は、引数はParamArrayキーワードを使い、Variant型で作成します。 （逆に言うとVariant型でしか宣言できません）
したがってデータ型の宣言を省略すると自動的にVariant型になるので、あえて型を指定しないで宣言します。
次のサンプルはSUM()関数と同様に、離れた場所に点在する数値の合計をセル番地を引数として指定し、その合計を返します。

test関数を使用する際に引数を指定しますが、その際にカンマで区切るとそのひとつひとつがaa配列の各要素となります。
各要素を分離するために、まずFor Eachステートメントを使ってbbに各要素の内容を取り出します。
次に、取り出されたbbはあるセル範囲を表している可能性がありますので、さらにFor Eachを使って個々のセルに分離します。
したがって変数ccはオブジェクト型（Range）で宣言しておきます。
あとはValueプロパティを使ってセルの値を取り出し、累計を計算する式に当てはめれば完成です。

Public Function test(ParamArray aa()) As Currency Dim gk As Currency Dim bb As Variant Dim cc As Range For Each bb In aa For Each cc In bb gk = gk + cc.Value Next Next test = gk End Function

セルの値を何度も更新するような処理をさせる場合に、処理の途中で再計算機能が実行され、実行速度に大きな影響が及ぶことがあります。
このようなときは一時的にExcelの再計算機能をオフにして処理を進め、最後に再計算させることで速度アップを図ることができます。

'再計算を「手動」にする Application.Calculation = xlManual 'セルに数値を入力する Range("A1").Value = 123 Range("A2").Value = 456 Range("A3").Value = 789 '再計算を「自動」に戻す Application.Calculation = xlAutomatic

上のようなプロシージャでは、再計算機能を止めなければ、A4にSUM関数（ =SUM(A1:A3) ）が入力されている場合、3回もSUM関数が実行されてしまいます。

セルを選択している状態で、右クリックしたとき表示されるショートカットメニューから自作のマクロを実行させたいときがあります。この場合はあらかじめメニュー追加のコードを用意しておきます。
まずVBエディタで標準モジュールを挿入し、そこへメニュー追加のサブプロシージャを作成します。
サンプルではRightClickプロシージャでメニュー追加の処理をさせています。
後はこのプロシージャを操作の前に実行すれば、いつでも自作のマクロを呼び出すことができます。
ただこのままですと、このワークブックを閉じた後もショートカットメニューにマクロ名が残りっぱなしになってしまいますので、終了時に必ずメニュー登録解除のプロシージャを実行しておく必要があります。
サンプルではMenuResetプロシージャがそれに該当します。

Public Sub MsgOut1() MsgBox "メッセージ-1が呼び出されました。" End Sub Public Sub MsgOut2() MsgBox "メッセージ-2が呼び出されました。" End Sub Public Sub RightClick() '右クリックメニューに項目を追加 Dim myRight As CommandBar '右クリックメニューをオブジェクト変数に代入 Set myRight = Application.CommandBars("Cell") '右クリックメニューにメニュー追加 With myRight '１番目に追加 .Controls.Add Type:=msoControlButton, Before:=1 .Controls(1).Caption = "メッセージ-1" .Controls(1).OnAction = "MsgOut1" '２番目に追加 .Controls.Add Type:=msoControlButton, Before:=2 .Controls(2).Caption = "メッセージ-2" .Controls(2).OnAction = "MsgOut2" End With End Sub Public Sub MenuReset() '右クリックメニューをリセット Application.CommandBars("Cell").Reset End Sub

1行目が見出しのため、1行目を除いたデータが格納されている全範囲を選択したいときがあります。
そのような場合はいったん全範囲を選択した後、OffsetプロパティとResizeプロパティを使って選択範囲を調整します。

Range("A1").CurrentRegion.Select Selection.Offset(1).Resize(Selection.Rows.Count - 1).Select Selection.ClearContents

上記ではA1以下にデータが存在する場合です。
Offset(1)はOffset(1,0)と同じ意味です。現在位置より下方へ1行下がります。
Resize変更したセル範囲の「Rangeオブジェクト」を再取得するプロパティです。

A列データの最後の行番号を取得する場合は、ワークシートの最終行から上方向に検索します。
ワークシートのMAX行は65536行なので、その位置から「End」キーを押した状態で「↑」キーを押す操作を記述します。

Dim r As Long r = Range("A65536").End(xlUp).Row

これで変数ｒに、A列のデータ最後尾の行番号が格納されます。

特定の列の最後のデータを調べるには上記の方法でよいですが、住所録など1件のデータが複数の列で構成されている場合、検査する列（例えばA列）がたまたま空白であった場合はうまくいきません。
このような場合はUsedRangeプロパティを利用して、データが格納されている範囲のアドレスから最後の行番号を得ることも可能です。

Dim adr As String Dim pos As Integer Dim r As Long adr = ActiveSheet.UsedRange.Address pos = InStrRev(adr, "$") r = Val(Right(adr, Len(adr) - pos))

変数adrには絶対番地で、"$A$1:$D$10"のようなデータが格納されている範囲のアドレスが入ります。
このアドレスから終わりの行番号だけを求めています。
ただしセルに何も値が入ってないように見えても、書式設定などがしてあるとそれも使用領域の一部にみなされますので注意してください。

いちいちメニューバーから「ツール」→「マクロ」→「マクロ」で呼び出すのは、何度も行わなければいけないマクロの場合は大変不便ですね。
Alt + F8でも同様のことはできますが、それでも３ステップの動作が必要です。
そこで自作マクロをメニューバーに登録することにより、１回の動作でマクロを実行させることが可能になります。
ツールバーにはキャプションとアイコンの両方を登録できるので、うまく利用すれば非常に分かりやすいボタンを作成できます。
FaceIdプロパティでWindowsに登録されているアイコンを番号で指定してください。

'マクロツールバーを作成します。 Public Sub OriginalBar() Dim myCB As CommandBar Dim myCBCtrl As CommandBarButton Set myCB = CommandBars.Add(Name:="MainMenu", temporary:=True) 'First Button Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) With myCBCtrl .Caption = "マクロの説明" .FaceId = 92 'アイコン .OnAction = "マクロの名前" End With 'Display Tool Bar With Application.CommandBars("MainMenu") .Visible = True .Position = msoBarTop End With End Sub 'ThisWorkBookのWorkbook_Openイベントで呼び出します。 Private Sub Workbook_Open() 'マクロツールバーの作成 OriginalBar End Sub 'ThisWorkBookのWorkbook_BeforeCloseイベントで削除します。 Private Sub Workbook_BeforeClose(Cancel As Boolean) 'マクロツールバーの削除 On Error Resume Next Application.CommandBars("MainMenu").Delete On Error GoTo 0 End Sub

シート全体の書式と値を消去します
Cells.Clear

シート全体の列幅を、入力された文字列の長さに合わせて調整します
Cells.EntireColumn.AutoFit

コピー対象の範囲に非表示の行列が含まれる場合、そのままでコピーを実行すると非表示部分のセルも一緒にコピーされてしまいます。
このようなときはメニューバーから「編集」→「ジャンプ」→「セル選択」→「選択オプション」ダイアログの可視セルを選択した状態にしてコピーをおこないますが、 同様の操作をＶＢＡでコーディングすることで実現できます。

Range("A1").CurrentRegion.Select '可視セルのみをコピー Selection.SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet2").Select ActiveSheet.Paste Application.CutCopyMode = False

シートまたはユーザーフォームにテキストボックスを貼付け、 KeyPressイベントを選択して、その中に以下のコードを記述します。
キー押し下げ時に、どのキーが押されたかを判定し、0〜9以外だったら 内容をクリアしてビープ音を鳴らします。

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 　　　If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then 　　　　　KeyAscii = 0 　　　　　Beep 　　　End if End Sub

表やテーブルなどを作成し、その中での相対的な位置を指定して何かをさせたい場合はありませんか？
Offset以外にもRangeとCellsを組み合わせて記述することで同様のことができます。

(A) そのまま指定すると、文字"A"がA1〜E4まで入力されます Range(Cells(1, 1), Cells(4, 5)).Value = "A" (B) Rangeオブジェクトで範囲を設定した上で指定すると、 C6からの相対的な位置（C6〜G9）に文字"B"が入力されます Dim Test As Range Set Test = Range("C6:G9") Test.Range(Cells(1, 1), Cells(4, 5)).Value = "B"

グラフの元データを別なデータに、任意に差替えたいときはどうしたらよいでしょうか？
この場合、現在描画しようとしているグラフActiveChartのSetSourceDataメソッドで、データ範囲を指定することができます。
PlotBy引数を指定することにより、任意の方向をデータ系列としてグラフを作成することもできます。
引数PlotByは必要に応じて指定してください。列方向はPlotBy:=xlColumnsとします。行方向PlotBy:=xlRowsは省略可能です。
省略した場合には、データの形状に応じて自動的に判断されるようです。

Public Sub test1()   ActiveSheet.ChartObjects("グラフ 1").Activate   ActiveChart.SetSourceData Source:=Range("A1:D4"), PlotBy:=xlRows End Sub Public Sub test2()   ActiveSheet.ChartObjects("グラフ 1").Activate   ActiveChart.SetSourceData Source:=Range("A8:D11"), PlotBy:=xlRows End Sub

通常のメニューバーの最後に追加する場合（ヘルプの右横）を紹介します。

Public Sub AddMenuBar()   'ワークシート上のメニューバーを定義   Const MenuType = "Worksheet Menu Bar"   '追加するメニューを定義   Dim MainMenu As CommandBarControl   'メニューの追加（最後へ）   Set MainMenu = CommandBars(MenuType).Controls.Add _     (Type:=msoControlPopup, Temporary:=True)   'メニューの名前   MainMenu.Caption = "自作マクロ呼び出し(&M)"   'メニュー呼び出しプロシージャの設定   MainMenu.OnAction = "CallMyMacro" End Sub

ちょっと一時的にテキストファイルに書き込みたいとき、ファイルシステムオブジェクト（FSO)を使った、次のコードが便利です。
まずCreateObject関数でFileSystemObjectであるFSOを作成します。
そしてテキストファイルを開きます。
下の例ではOpenTextFileメソッドで、ファイルを開くモード（ioMode）に2を指定して、上書きモードで開いています。
モードには1：読取専用、2：上書き、8：追記モードがあります。
また３番目の引数は、ファイルが存在しない場合の指定で、True：存在しない場合新規作成する、False:新規作成しない（規定値）となっています。
次にWriteLineメソッドで1 行の文字列をテキストファイルに書き込みます。
最後にCloseメソッドでバッファをフラッシュしファイルを閉じます。
既に同名のファイルが存在する場合は、上書きされて以前のデータは消えてしまいますので注意してください。
なお１番目のファイルのパス以外は、すべて省略可能です。

Public Sub OutputText()   Dim FSO   Dim OSB   Dim strPath As String   Set FSO = CreateObject("Scripting.FileSystemObject")   strPath = "C:\フォルダ名"   strPath = strPath & "\" & "temp.txt"   '上書きモードで開きます（ファイルが存在しなければ新規作成）   Set OSB = FSO.OpenTextFile(strPath, 2,True)   '文字を書き込む   OSB.WriteLine "ABCDEFG"   OSB.Close   Set FSO = Nothing   Set OSB = Nothing End Sub

ファイルを削除する場合の例です。
ここでは従来のBisualBasicのコマンド”Kill”を使っています。
削除しようとするファイルが見つからなかった場合の対応として、”On Error Resume Next”でエラーを無視して次のコードへ進んでいます。

Public Sub DeleteFile()   Dim myPath As String   myPath = ThisWorkbook.Path & "\" & "test1.txt"   On Error Resume Next   Kill myPath   On Error GoTo 0 End Sub

FSOを使ったファイルを削除する場合の例です。
Deleteメソッドを使っています。

Public Sub DeleteFile2()   Dim FSO   Dim myPath As String   myPath = ThisWorkbook.Path & "\" & "test2.txt"   Set FSO = CreateObject("Scripting.FileSystemObject")   On Error Resume Next   FSO.GetFile(myPath).Delete   On Error GoTo 0   Set FSO = Nothing End Sub

Shiftキー、Ctrlキー、Altキーと他のキーとの組み合わせを指定するには、通常のキーコードの前に次の記号を付加します。

Shift　：　+   Ctrl　：　^   Alt　：　%   【例】   Altキーを押しながらF11キーを押す　→　SendKeys "%{F11}",True

転送するキーコード（文字列式）は、必ず""で囲みます。
キーコードの転送によって実行される処理が終了するまで、次の動作を一時ストップしておきたい場合は、カンマで区切ってTrueを指定します。
何も指定しなければFalseと見なし、処理の終了を待たずに次の行に制御を移します。

ワークシートにいくつかのオートシェイプが置いてあり、それをクリックしたときに、そのオブジェクトに色をつける例で説明します。
どのオブジェクトをクリックした場合も、同じプロシージャが呼び出されるようにし、そのプロシージャで、どのオブジェクトから呼び出されたかが分かるようにすれば、簡潔なマクロが組めそうですね。
この例では分かりやすいようにプロシージャを2つに分けて、objColorプロシージャで呼び出し元のオブジェクトを判別し、取得したオブジェクト名をFormatColorRedBlueプロシージャに引数として渡してあげて、そこで色を変更するようにしています。

ところでオートシェイプにマクロを登録する方法は、ワークシートに配置したオートシェイプ上で右クリックし、ポップアップメニューから「マクロの登録」を選択します。マクロの一覧からobjColorプロシージャを指定して「OK」ボタンを押せば、マクロが登録されます。
ではマクロを登録したら、試してみましょう。任意のオートシェイプを一度クリックすると、そのオートシェイプの色が変わり、もう一度クリックすると、元の色に戻りますね。

ここで重要なのはApplication.Callerプロパティを利用することにより、どのオブジェクトからマクロを呼び出したかが識別できるようになることです。

Public Sub objColor()   Dim oj As String   oj = ActiveSheet.DrawingObjects(Application.Caller).Name   FormatColorRedBlue oj End Sub Public Sub FormatColorRedBlue(oj As String)   Dim c As Integer   c = ActiveSheet.DrawingObjects(oj).Interior.ColorIndex   If c = 3 Then     c = 4   Else     c = 3   End If   ActiveSheet.DrawingObjects(oj).Interior.ColorIndex = c End Sub

変数のデータ型に論理値を扱うboolean型がありますが、これを使うと真（True）と偽（False）の２値を使った判定が可能になることはご存知ですね。
この型で宣言した変数をフラグとして利用する場合に、フラグの中身を反転させる必要が生じたとき、みなさんはどうしますか？
Ifを使ってフラグの中身をセットする方法は誰でも思いつくとおもいますが、もっと簡単に反転させる方法があります。
一つはNotを使った式を使う方法、もう一つは条件式の結果を利用する方法です。

test1ではNotを使うことによりビットが反転しますので、真偽も反対になります。
test2ではa=1を括弧でくくることにより条件式となりますので、a=1を評価して、一致していれば真（True）が変数flgに格納され、不一致の場合は偽（False）が格納されます。

Public Sub test1()   'Notを使った式   Dim flg As Boolean   flg = True   flg = Not flg   MsgBox "フラグは" & flg & "です。" End Sub Public Sub test2()   '条件式の結果を利用   Dim flg As Boolean   Dim a As Integer   a = 1   flg = (a = 1)   MsgBox "フラグは" & flg & "です。"   flg = (a <> 1)   MsgBox "フラグは" & flg & "です。" End Sub

データ件数が多いとき、どの行を眼で追っていたかわからなくなるのを助けます。
シート上でクリックすると、その行だけ色がつきます。
単純ですが結構便利ですよ。
ワークシートのSelectionChangeイベントに記述してください。
色はRGB関数で指定します。それぞれ0（暗）〜255（明）までを、R（赤）G（緑）B（青）の要素別に指定してください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)   Dim r As Long   '２行目以降でＡ列が空欄でないものが対象   r = Target.Row   If r > 1 And Range("A" & r).Value <> "" Then     'セル全体の色を初期化     Cells.Interior.ColorIndex = xlNone     'クリックした行に色（ペールブルー）を付ける     Range(r & ":" & r).Interior.Color = RGB(100, 200, 255)   End If End Sub

ワークシート上に配置したオートシェイプやコマンドボタンの名前を知りたいとき、Shapesコレクションを使って調べることができます。
Shapesコレクションというのは、配置したオートシェイプやコマンドボタンの総称です。
例では、このコレクションをFor Each ステートメントで一つづつ名前を調べて、イミディエイトウィンドウに書き出しています。
イミディエイトウィンドウは、デバッグの際によく使うウィンドウで、「Ctrl + G」でコードウィンドウの下に表示されます。

Public Sub CheckObj()   Dim ob As Shape   For Each ob In Worksheets(1).Shapes     Debug.Print ob.Name   Next ob End Sub

ユーザーフォームの終了ボタンに特別の処理を持たせているとき、オペレータにフォームを「×」ボタンでいきなり閉じられないようにするためのコードです。
フォームを閉じる際には、必ずQueryCloseイベントが発生するので、そのときに閉じる理由が何であるかを判定してあげれば、動作を区別することが可能になります。
コードから閉じる場合は、引数にCloseMode=1（定数はvbFormCode）が渡りますが、「×」ボタンから閉じる場合はCloseMode=0になります。
値が1でなければ、メッセージを表示し、引数にCancel = 1をセットして、閉じる動作そのものをキャンセルします。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)   If CloseMode <> vbFormCode Then     MsgBox "［×］ボタンでは閉じれません。" & vbCrLf _     & "「終了」ボタンで閉じてください。"     Cancel = 1   End If End Sub

計算式の中で文字列を引用符で囲むときは、引用符を重ねて囲みます。
例では、セルに書き込むときは=If(A1>0,"○","×")で表現されます。

Public Sub test()   Cells(2, 1).Formula = "=If(A1>0,""○"",""×"")" End Sub

グラフのサイズは、グラフエリアの周りに表示されるサイズ変更ハンドルをドラッグすることで自由に変更できますが、複数のグラフを同じ大きさに揃えることは案外難しいものです。
このコードを実行すると、グラフの幅と高さを聞いてきますので、その値をcmで入力します。
どちらかの値が0の場合、または「キャンセル」ボタンが押されたときは、処理を中止します。
この処理はアクティブなシートに配置されているグラフに対してだけ実行されます。
【注意】
「キャンセル」ボタンが押されたときは、InputBox関数から数値が返ってきませんので、そのままだとエラーになってしまいます。
そこでVal関数を使ってすべて数値に変換した上で判定しています。

Public Sub SameSize()   Dim myCht As ChartObject   Dim gWidth As Integer   Dim gHeight As Integer   Dim myMsg As String   Dim myTitle As String   myTitle = "グラフサイズ指定"   myMsg = "グラフの幅を入力してください。"   gWidth = Val(InputBox(myMsg, myTitle, 0))   myMsg = "グラフの高さを入力してください。"   gHeight = Val(InputBox(myMsg, myTitle, 0))   myTitle = "キャンセル処理"   myMsg = "実行を中止します。"   If gWidth = 0 Or gHeight = 0 Then     MsgBox myMsg, vbExclamation, myTitle     Exit Sub   End If   'グラフサイズを設定   For Each myCht In ActiveSheet.ChartObjects     myCht.Width = gWidth     myCht.Height = gHeight   Next End Sub

現ブックに複数のシートがある場合、どれか一つだけを新規ブックにコピーし、名前を付けて保存するマクロです。 新ブックには一つだけシートが作成されています。
手動で行う場合は、シートタブを右クリックして、「移動またはコピー」→「移動先ブック名」を（新しいブック）に変更→「コピーを作成する」にチェックをつけるという操作になります。

Public Sub SingleSheetCopy()   Dim SheetName As String   Dim NewBook As String   SheetName = "Sheet1" 'コピー元シート名   NewBook = "CopyTest.xls" 'コピー先ブック名   Worksheets(SheetName).Copy   ActiveWorkbook.SaveAs Filename:=NewBook   ActiveWorkbook.Close End Sub

データの増減に合わせて、範囲名を自動で設定するマクロです。
例ではSheet1のB列２行目からデータが入力されており、そのデータ件数が増減する場合を想定しています。

Public Sub RangeReName()   Dim r1 As Integer   Dim r2 As Integer   Dim RngName As String   '設定する範囲名   RngName = "範囲B"   'データの先頭の行   r1 = 2   'データの最後の行   r2 = Range("B" & r1).End(xlDown).Row   ActiveWorkbook.Names.Add Name:=RngName, _     RefersToR1C1:="=Sheet1!R" & r1 & "C2:R" & r2 & "C2" End Sub

これはワークシートのWorksheet_Changeイベントへ記述してください。
Worksheet_Changeイベントでは、すべてのセルで更新があった場合にイベントが発生してしまいますが、実際には特定セルでの更新のみを対象とすることがほとんどだと思います。
そこでIntersectメソッドを利用することで、簡単に特定セルを判定することができるようになります。
Intersectメソッドで、いくつかの引数（範囲）を列挙することで、その共有範囲を返します。
Target引数には更新中のセル情報（Rangeオブジェクト）が入るので、これと２番目に指定した範囲との共有部分があるかを判定し、あった場合の処理を記述します。
例ではA1からA10の範囲でセルの更新があった場合のみ、メッセージボックスを表示させます。
実際はここに何か具体的な処理を入れてください。

最後に、ひとつ注意しなければいけないことがあります。
引数Targetにセル1つの範囲しか入っていない場合は問題ないのですが、セルを複数選択した状態で変更するなどして、いくつかのセル範囲が入ってきた場合は、そのうちの1つでもIntersectメソッドで指定した範囲と重なれば有効とみなされます。
したがって想定外の結果がおこる場合もありますので、注意が必要です。

Private Sub Worksheet_Change(ByVal Target As Range)   Dim isect As Range   Application.EnableEvents = False   Set isect = Application.Intersect(Target, Range("A1:A10"))   If Not isect Is Nothing Then     MsgBox "処理対象セルです。"   End If   Application.EnableEvents = True End Sub

OpenメソッドのUpdateLinks引数に0を指定することでメッセージが表示されなくなります。
また、必ず更新するようにするには3を指定します。

【ヘルプ】
UpdateLinks
ファイル内のリンクの更新方法を指定します。
リンクが設定されているファイルを開くとき、この引数を省略すると、リンク更新のダイアログ ボックスが表示されます。

次のいずれかの値を指定します。

値 内容
0 外部参照、リモート参照ともに更新されません。
1 外部参照は更新され、リモート参照は更新されません。
2 リモート参照は更新され、外部参照は更新されません。
3 外部参照、リモート参照ともに更新されます。

外部参照とは他のブックを参照している場合を指します。
リモート参照とは別のアプリケーションへリンクされている場合を言うようです。

Public Sub Sample()   'リンクを更新しないで開く   Workbooks.Open FileName:="C:\Book1.xls", UpdateLinks:=0   'リンクを更新して開く   Workbooks.Open FileName:="C:\Book1.xls", UpdateLinks:=3 End Sub

入力する人が次にどこに入力すればよいかが分かるように、特定のセルのみ選択できるようにしてあげることができます。
このコードを実行すると、セルに入力後EnterキーまたはTabキーを押すことで、次の入力すべきセルへセルポインタがジャンプします。
他のセルは選択できないようになっているので、入力者も迷うことはありません。
手順としては、あらかじめ入力すべきセルのロックをはずしておきます。（書式→セル→保護→ロックのチェックをはずす）
次にコードでシート保護をかけた後、EnableSelectionプロパティでxlUnlockedCellsを指定することで、ロックをはずしたセルのみしか選択できないようになります。

Sub Sheet_Protect()   ActiveSheet.Protect   ActiveSheet.EnableSelection = xlUnlockedCells End Sub

ただしこの「保護されたセルを選択不可にする」マクロは、実行した直後は有効ですが、次回このマクロを実行したブックを開いても、セル選択ができてしまいます。
常にこの状態を作り出すためには毎回このマクロを実行する必要がありますので、その場合はThisWorkbookのWorkbook_Open()イベントに記述してください。

あるシートにコマンドボタンを作成して、他のシート上のセルを選択しようとしたとき、エラーになることがあります。（［コントロールツールボックス］から作成した場合）
例えばSheet1上のコマンドボタンからSheet2のセルA1を選択しようとした場合、下記のコードを書いてしまうと、実行時エラー'1004'  「RangeクラスのSelectメソッドが失敗しました。」のメッセージが出て処理が中断してしまいます。

Private Sub CommandButton1_Click()   Sheets("Sheet2").Select   Range("A1").Select End Sub

この場合は、いったん「操作したいワークシートをアクティブにして、そのシート上のセルA1を選択」とすることで回避できます。

Private Sub CommandButton1_Click()   Sheets("Sheet2").Activate   ActiveSheet.Range("A1").Select End Sub

または標準モジュールに先ほどエラーになったコードを記述して、コマンドボタンでそのプロシージャを呼び出す形にすると今度は正常に動作します。

Public Sub test()   Sheets("Sheet2").Select   Range("A1").Select End Sub Private Sub CommandButton1_Click()   test End Sub

結論としてはシート上のコマンドボタンから、直接他シートのセルをselectすることはできないようです。

標準モジュールに次のコードを書いて実行してください。
最初の例では現在開いているExcelのバージョンが表示されます。
バージョンにより記述できるコードが異なるような場合に利用できます。
これを応用して2番目の例ではバージョンによってシート保護のコードを分岐させて実行しています。
１つ注意しておかなければいけないのは、分岐内のコードは必ず実行時バインド型のコードにしておくことです。 実行前バインド型のコードだと、実行前にコンパイルエラーで止まってしまいます。

Public Sub DispVersion() 'Excelのバージョンを表示 Dim V As String V = Application.Version Select Case V Case "7.0" MsgBox "Excel95 : " & "Version = " & V Case "8.0" MsgBox "Excel97 : " & "Version = " & V Case "8.0d" MsgBox "Excel97 SR-1 : " & "Version = " & V Case "9.0" MsgBox "Excel2000 : " & "Version = " & V Case "10.0" MsgBox "Excel2002 : " & "Version = " & V Case "11.0" MsgBox "Excel2003 : " & "Version = " & V Case "12.0" MsgBox "Excel2007 : " & "Version = " & V End Select End Sub 例：バージョン分岐によるシート保護処理 If Val(Excel.Application.Version) >= 10 Then 'Ecel2002以上 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True, UserInterfaceOnly:=True, _ AllowFormattingColumns:=True Else 'Excel2000以下 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _ Scenarios:=True, UserInterfaceOnly:=True End If

現在開いているブックのショートカットを、WSHの機能を利用してデスクトップ上に作成します。
通常は手動で行うことがほとんどでしょうが、自分以外の人にブックを使ってもらうときのセットアップ用に便利かもしれません。

Public Sub MakeSC1()   Dim WSH As Object   Dim DeskP As String   Dim ShortC As Object   'WSHオブジェクトを作成   Set WSH = CreateObject("WScript.Shell")   'デスクトップのパスを取得   DeskP = WSH.SpecialFolders("Desktop")   'ショートカットオブジェクトを作成   Set ShortC = WSH.CreateShortcut(DeskP & "\" & ActiveWorkbook.Name & ".lnk")   'ショートカットのリンクを設定   ShortC.targetPath = ActiveWorkbook.FullName   'ショートカットをデスクトップに作成   ShortC.Save   'オブジェクトを解放   Set ShortC = Nothing   Set WSH = Nothing End Sub

任意のブックに対して作成することもできます。
「ファイルを開く」ダイアログを使って、目的のブックを指定するだけです。 後の処理はほとんど同じです。
注意したいのは「ファイルを開く」ダイアログで「キャンセル」ボタンが押されたときの判定です。
ここでは「キャンセル」ボタンが押されると、“False”が文字列で返ってくるのを利用して以降の処理を中止しています。
利用価値はあまりないかも知れませんが、一応掲載しておきます。

Public Sub MakeSC2()   Dim TargetF As String   Dim TargetP As String   Dim WSH As Object   Dim DeskP As String   Dim ShortC As Object   '「ファイルを開く」ダイアログ表示   TargetF = Application.GetOpenFilename("Microsoft Excelブック,*.xls")   'ショートカットを作成するファイル名を取得   If TargetF <> "False" Then     TargetP = Right(TargetF, Len(TargetF) - _       InStrRev(TargetF, "\", , vbTextCompare))   Else     MsgBox "キャンセルされました。"     Exit Sub   End If   'WSHオブジェクトを作成   Set WSH = CreateObject("WScript.Shell")   'デスクトップのパスを取得   DeskP = WSH.SpecialFolders("Desktop")   'ショートカットオブジェクトを作成   Set ShortC = WSH.CreateShortcut(DeskP & "\" & TargetP & ".lnk")   'ショートカットのリンクを設定   ShortC.targetPath = TargetF   'ショートカットをデスクトップに作成   ShortC.Save   'オブジェクトを解放   Set ShortC = Nothing   Set WSH = Nothing End Sub

保存先にフォルダを作成して、そこに新規ブックを保存するマクロです。
すでに同名のフォルダが存在する場合は、作成処理をスキップしてそのままそこに保存します。
このプロシージャを実行すると、まず新規のブックが1つ作成されます。
次に新規ブックのSheet1のA1セルに適当な値を書き込む処理を1行書いています。
書き込みが終わったら、新規ブックに名前を付けて、先ほど作成したフォルダに保存をします。
このとき既に同名のブックがあったとしても、そのまま上書きで保存されるように警告メッセージを出さないようにしています。
反対に上書き保存の確認メッセージが必要なときは、“Application.DisplayAlerts = False”を外して下さい。

Public Sub SaveNewBook()   Dim MyDir As String   Dim MyBook As String   Dim MyNew As Workbook   '保存先のディレクトリを作成（既に存在する場合はスキップ）   On Error Resume Next   MkDir ThisWorkbook.Path & "\_test"   On Error GoTo 0   '新規ブック名とパスを設定   MyDir = ThisWorkbook.Path & "\_test"   MyBook = "NewBook.xls"   '新規ブックを作成   Set MyNew = Workbooks.Add   '新規ブックに値を格納   ActiveWorkbook.Sheets(1).Range("A1").Value = "This is a NewBook."   '新規ブックに名前を付けて保存   Application.DisplayAlerts = False   MyNew.SaveAs Filename:=MyDir & "\" & MyBook   Application.DisplayAlerts = True   'Excelを終了する   Application.Quit End Sub

別なブックに特定の標準モジュールをコピーしたいときのコード例です。
使い道は色々考えられると思いますが、ここでは動作の説明だけしておきます。
この処理ではあらかじめモジュールのコピー先ブックが決まっており、そのブックに現在のブックの標準モジュールをコピーしようというものです。
新規のブックにコピーする場合は、自分で一部手直ししてください。

まずコピー先ブックを開きます。
コピー先ブックが見つからない場合は、処理を中止するようにしています。
ブックが存在しないときは新規にブックを作成するように変更してもよいでしょう。
次にこのマクロが書かれたブックのモジュール（標準モジュール２）を“TestM.bas”というファイル名でエクスポートします。ファイル名はそのまま“Module2”としてもかまいません。
引き続き今度はコピー先のブックに同モジュールをインポートします。
最後はコピー先ブックのみが画面上に表示されるので、モジュールの存在を確認してください。

標準モジュール１のプロシージャ Public Sub CopyModule()   Dim MyDir As String   Dim CBook As Workbook   Dim MyComp As Object   Dim ModuleFile As String   'コピー先ブックのパス   MyDir = ThisWorkbook.Path & "\Test.xls"   'コピー先ブックを開く   On Error GoTo ERR_SHORI   Set CBook = Workbooks.Open(MyDir)   On Error GoTo 0   'このブックのModule2をエクスポート   ModuleFile = ThisWorkbook.Path & "\TestM.bas"   Set MyComp = ThisWorkbook.VBProject.VBComponents("Module2")   MyComp.Export ModuleFile   'コピー先ブックにインポート   CBook.VBProject.VBComponents.Import ModuleFile   'このブックを閉じる   ThisWorkbook.Close ERR_SHORI:   MsgBox Err.Description & _     vbCrLf & "処理を中止します。"   'Excelを終了する   Application.Quit End Sub 標準モジュール２のプロシージャ Public Sub test()   MsgBox "This is a Module2." End Sub

別なブックから、特定の標準モジュールを解放（削除）します。
このサンプルでは、特定のブック（abc.xls）に含まれている標準モジュール（Module1）を削除する例を示しています。なお2つのブックは同じ場所にあるものとします。
削除対象とするモジュールがない場合は、メッセージを表示して処理を中止します。
先のモジュールのコピーと組み合わせることで、モジュールの入れ替えができるかもしれません。

Public Sub DeleteModule()   '削除対象モジュールを含むブックを開く   On Error GoTo ERR_SHORI   Workbooks.Open ThisWorkbook.Path & "\abc.xls"   On Error GoTo 0   '標準モジュールを解放する   On Error GoTo ERR_SHORI   With Workbooks("abc.xls").VBProject     .VBComponents.Remove .VBComponents("Module1")   End With   On Error GoTo 0   '解放後のブックを上書き保存する   ActiveWorkbook.Save   'Excelを終了する   Application.Quit   Exit Sub ERR_SHORI:   If Err.Number = 9 Then     MsgBox "削除対象モジュールが見つかりませんでした。" & _      vbCrLf & "処理を中止します。"   Else     MsgBox Err.Description & _      vbCrLf & "処理を中止します。"   End If   'Excelを終了する   Application.Quit End Sub

ファイルパスからファイル名のみを取り出して返す関数です。
引数にそのファイルまでのフルパスを与えると、ファイル名だけを取り出して返してくれますので、いろいろなケースで部品として使えると思います。

まずInStrRev関数を使って、引数のパスの後ろから\記号が含まれているかどうかを調べていきます。 \記号が見つからなければlngPos=0のままで、\記号が見つかるとその位置がlngPosに格納されます。
今度は同様にピリオド（.）が含まれているかどうかを調べ、そのピリオドの位置と先ほどの\記号の位置とを比較します。
\記号の位置よりもピリオドの位置が後にあれば、それはファイル名と拡張子を分けているピリオドであると判断できるので、その場合はblnInclude=Trueとなります。
引数のパスに\記号が含まれており（lngPos > 0）、なおかつ\記号より以降にピリオドが見つかった場合（blnInclude=True）は、\記号以降の部分がファイル名と考えられるので、その部分を取り出し、関数の戻り値としてセットしてあげます。

ちなみにパスからファイル名を除いた部分を取り出す場合は�Aのようにします。

Function NameFromPath(strPath As String) As String Dim lngPos As Long Dim strPart As String Dim blnInclude As Boolean 'ファイルパスかどうかを調る lngPos = InStrRev(strPath, "\") blnInclude = InStrRev(strPath, ".") > lngPos '�@パスからファイル名部分を取り出す If lngPos > 0 Then If blnInclude Then strPart = Right$(strPath, Len(strPath) - lngPos) End If End If NameFromPath = strPart End Function Public Function FolderFromPath(strPath As String) As String Dim lngPos As Long Dim strPart As String Dim blnInclude As Boolean 'ファイルパスかどうかを調る lngPos = InStrRev(strPath, "\") blnInclude = InStrRev(strPath, ".") > lngPos '�Aパスからファイル名を除いた部分を取り出す If lngPos > 0 Then If blnInclude Then strPart = Left$(strPath, lngPos) End If End If FolderFromPath = strPart End Function

複数のブックを用いてマクロで処理をする場合に、よく見かける書き方です。
ここではブックのCountプロパティを調べてその数だけループして調べるやり方と、Workbooksコレクションの各要素（Workbookオブジェクト）に対して順番に調べていく方法を紹介しておきます。

■For Next を使った例 Sub OpenList_1() Dim i As Long Dim tmp As String For i = 1 To Workbooks.Count tmp = tmp & Workbooks(i).Name & vbCrLf Next i MsgBox "現在開いているブックは、" & vbCrLf & tmp & "です。" End Sub ■For Each Next を使った例 Sub OpenList_2() Dim wb As Workbook Dim tmp As String For Each wb In Workbooks tmp = tmp & wb.Name & vbCrLf Next wb MsgBox "現在開いているブックは、" & vbCrLf & tmp & "です。" End Sub

メニューバーの一部の項目を無効にして、ユーザーに直接操作されないようにすることができます。
こうすることで、ユーザーに必ずマクロを使って操作してもらうことができ安全です。
ただし、ツールバーは普通に使用できるので、こちらも別に対策をしておかなければ意味がないかもしれません。
下の例ではメニューバーから「ファイル」→「上書き保存」と「ファイル」→「名前を付けて保存」が選択できないようにしています。
メニューの項目は直接Controls("上書き保存(&S)")というように指定してもよいし、インデックス番号でControls(4)のようにしてもかまいません。
注意すべきことはExcelを終了する前に、必ずメニューバーを元の状態に戻しておかなければ、永久にそのままの状態になってしまいます。

Private Sub Workbook_Open() '*************************************************** ' 「ファイル」→「上書き保存」を無効にする ' 「ファイル」→「名前を付けて保存」を無効にする '*************************************************** Dim MyMenuBar As CommandBar Set MyMenuBar = Application.CommandBars("Worksheet Menu Bar") MyMenuBar.Controls(1).Controls(4).Enabled = False '上書き… MyMenuBar.Controls(1).Controls(5).Enabled = False '名前を… End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) '*************************************************** ' 「ファイル」→「上書き保存」を有効に戻す ' 「ファイル」→「名前を付けて保存」を有効に戻す '*************************************************** Dim MyMenuBar As CommandBar Set MyMenuBar = Application.CommandBars("Worksheet Menu Bar") MyMenuBar.Controls(1).Controls(4).Enabled = True '上書き… MyMenuBar.Controls(1).Controls(5).Enabled = True '名前を… End Sub

下記のコードをUserFormモジュールに記述してください。
まずユーザフォームに予めCommandButton1を配置しておきます。
次回マクロによりユーザフォームを表示したときにCommandButton1を押すたびに、新しいコマンドボタンが最大3つまで追加されていきます。
また、それぞれ追加されたボタンを押すと、クリックイベントが発生し、メッセージを表示するようにしています。
なお冒頭のWithEventsでの宣言は、コマンドボタンのイベントを利用するためのものです。

Option Explicit Private WithEvents myB1 As MSForms.CommandButton Private WithEvents myB2 As MSForms.CommandButton Private WithEvents myB3 As MSForms.CommandButton Private Sub CommandButton1_Click() Static cnt As Long Dim cmdObj As MSForms.CommandButton Set cmdObj = Controls.Add("Forms.CommandButton.1") cnt = cnt + 1 Select Case cnt Case 1 Set myB1 = cmdObj 'myB1ボタンを追加 With myB1 .Top = 10 .Left = 10 .Width = 50 .Height = 24 .Caption = "myB1" End With Case 2 Set myB2 = cmdObj 'myB2ボタンを追加 With myB2 .Top = 10 .Left = 92 .Width = 50 .Height = 24 .Caption = "myB2" End With Case 3 Set myB3 = cmdObj 'myB3ボタンを追加 With myB3 .Top = 10 .Left = 174 .Width = 50 .Height = 24 .Caption = "myB3" End With CommandButton1.Enabled = False End Select End Sub Private Sub myB1_Click() MsgBox "myB1" & vbTab & "Top=" & myB1.Top & " : " & "Left=" & myB1.Left _ & " : " & "Height=" & myB1.Height & " : " & "Width=" & myB1.Width End Sub Private Sub myB2_Click() MsgBox "myB2" & vbTab & "Top=" & myB2.Top & " : " & "Left=" & myB2.Left _ & " : " & "Height=" & myB2.Height & " : " & "Width=" & myB2.Width End Sub Private Sub myB3_Click() MsgBox "myB3" & vbTab & "Top=" & myB3.Top & " : " & "Left=" & myB3.Left _ & " : " & "Height=" & myB3.Height & " : " & "Width=" & myB3.Width End Sub

ファイルを開くのではなくて、フォルダを指定するためのダイアログボックスを使いたいということは、よくあります。
ここではWindowsでよくおなじみのフォルダ参照ダイアログボックスを呼び出すためのコードを掲載しておきます。
ただ、この処理はVBAの機能だけでは実現できないため、APIを利用してWindowsの機能を利用することになります。 そのためにコードが少々長く、また難解になりますが、ほとんどはそのままコピー＆ペーストで動作すると思います。

まず下記のコードをすべて標準モジュールにそのまま貼り付けてください。
とくに冒頭の宣言部分は大事ですので、スペルミスがないようにしてください。
標準モジュールに記述したら、後は何らかの手段でプロシージャRefFolderを呼び出せば、フォルダ参照ダイアログボックスが開きます。
ここでは、一度指定したフォルダのパスをSheet1のセルA1に記憶させることで、2度目に開いたとき前回のフォルダを表示するようにしています。
ダイアログボックスで「キャンセル」を選択するか、セルA1を手動でクリアすれば、初期値の表示に戻ります。

Public Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA = (WM_USER + 102) Public Const BFFM_INITIALIZED = 1 Public Const CSIDL_DESKTOP = &H0 Public Const BIF_RETURNONLYFSDIRS = &H1 Public Const MAX_PATH = 260 Public Type BROWSEINFO hwndOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As String iImage As Long End Type Public Function BrowseCallbackProc(ByVal hWnd As Long, _ ByVal uMsg As Long, ByVal lParam As Long, _ ByVal lpData As Long) As Long '*************************************************** ' コールバック関数 '*************************************************** If uMsg = BFFM_INITIALIZED Then SendMessage hWnd, BFFM_SETSELECTIONA, 1, ByVal lpData End If End Function Public Function FARPROC(pfn As Long) As Long '*************************************************** ' AddressOf演算子の戻り値を戻す関数 '*************************************************** FARPROC = pfn End Function Sub RefFolder() '*************************************************** ' フォルダ参照ダイアログ呼び出し '*************************************************** Dim Browse As BROWSEINFO Dim pID& Dim PathName$ Dim Fn% With Browse .pidlRoot = CSIDL_DESKTOP .lpszTitle = "目的のフォルダを選択してください" .ulFlags = BIF_RETURNONLYFSDIRS .lpfn = FARPROC(AddressOf BrowseCallbackProc) .lParam = Worksheets("Sheet1").Range("A1").Value _ & vbNullChar '初期フォルダのパス名 End With '「フォルダの参照」ダイアログの呼び出し pID& = SHBrowseForFolder(Browse) If pID& Then '予めNull文字をセット PathName$ = String(MAX_PATH, vbNullChar) 'フォルダのパス名を取得 SHGetPathFromIDList pID&, PathName$ '割り当てられたメモリを開放 CoTaskMemFree pID& Fn% = InStr(PathName$, vbNullChar) If Fn% Then 'ワークシートに現在のパスを書き込む Worksheets("Sheet1").Range("A1").Value _ = Left(PathName$, Fn% - 1) End If Else Worksheets("Sheet1").Range("A1").Value = "" End If End Sub

普通に標準モジュールにSubプロシージャを記述すると、Excelの「ツール」→「マクロ」→「マクロ」でマクロ実行ウィンドウにマクロ名が表示されます。
しかし場合によっては、ユーザーに勝手にマクロウィンドウからマクロを実行されては困るというケースもあるでしょう。 そういうときには、PblicになっているSubプロシージャをPrivateに変更すると、マクロ名が表示されなくなります。
ただし、例えPrivateに変更してマクロウィンドウに表示されなくなっても、直接マクロ名を"test2"のように入力して、実行ボタンを押すと実行されてしまいますので、あくまでも実行しにくくするという程度に考えてください。

さらに、Privateに変更した場合は、呼び出し方法に少し注意が必要となります。
例ではSheet1にPublicのSubプロシージャとPrivateのSubプロシージャを呼び出した場合の結果を示しています。 Publicの場合は問題なくプロシージャは実行されますが、Privateでは図のようにエラーとなってしまいます。 これはプロシージャにも変数同様に実行できる有効範囲（スコープ）というものが決められており、Privateの場合はその記述された同一モジュール内でしか実行できないためです。 ちなみにPublicの場合は、どのモジュールからでも実行することができます。

また、Publicのままでも引数があると、マクロ名が表示されませんので、これを利用してダミーの引数を持たせるのも有効です。
ただし、これも呼び出し時に今度は必ず引数をつける必要がでてきます。

Functionプロシージャも引数あるなしに関わらずマクロウィンドウには表示されません。
しかしながらこれもExcelのユーザー定義関数を呼び出すウィンドウからは、実行ができてしまいますので注意してください。

Option Explicit 'マクロウィンドウに表示される Public Sub test1() MsgBox "test1" End Sub 'Privateはマクロウィンドウに表示されない Private Sub test2() MsgBox "test2" End Sub 'Publicでもダミー引数を持たせると 'マクロウィンドウに表示されない Public Sub test3(a As Integer) MsgBox "test3" End Sub 'Functionプロシージャは 'マクロウィンドウに表示されない Public Function test4(a As Integer) MsgBox "test4" test5 = "test4" End Function '引数がなくても表示されない Public Function test5() MsgBox "test5" test5 = "test5" End Function

自分が作ったシートでない場合、どのセルにロックがかかっていて、どのセルにかかっていないか不明なときがありますね。
手作業で一つ一つセルの書式を調べていってもいいですが、面倒な場合はマクロでいっきに調べる手もあります。
例ではロックが解除されているセルを調べていますが、CL.Locked = Trueに変更すれば、当然ロックがかかっているセルを調べることもできます。
下記コードはSheet1の範囲A1:E20を調べて、その結果をSheet2に出力しています。
結果を残したくなければ、Debug.Printでイミディエイトウィンドウに書き出せばＯＫです。

ただワークシート上で確認するだけだったら、ロックがかかっているセルを調べるで紹介した条件付書式設定で調べたほうが簡単です。 これはあくまでもセルの保護ロック情報をコードで使用する場合ということで参考にしてください。

Public Sub UnLockedCell() Dim CL As Range Dim i As Long i = 1 For Each CL In Sheet1.Range("A1:E20") If CL.Locked = False Then Sheet2.Cells(i, 1).Value = CL.Address i = i + 1 End If Next End Sub

すでにSheet1のA1:C1に見出しが設定されており、A2:C6にデータが入力されているものとします。
リストボックスのColumnHeadsプロパティをTrueにすることで見出し欄をリストボックス最上部に表示できます。
次にColumnCount、ColumnWidthsプロパティで列数と列幅を設定します。
データの参照範囲設定では必ずRowSourceプロパティを使用し、見出し行を除いた範囲をシート名を含めて指定します。
なおAddItemメソッドでリストボックスを作成した場合は、見出しの設定はできません。

Private Sub UserForm_Initialize() With ListBox1 .ColumnHeads = True '見出しあり .ColumnCount = 3 '列数 .ColumnWidths = "2cm;4cm;3cm" '列幅 .RowSource = "Sheet1!A2:C6" '参照範囲 End With End Sub

Now()関数で現在時刻を取得し、それにmySecに代入した秒数だけ経過した時刻に達したとき、Application.Waitを実行します。
TimeSerial関数では、時・分・秒を指定できますが、サンプルは現在時刻にある秒数を加えた時刻が必要なので、あえて時・分は指定していません。

Public Sub PauseMac() Dim mySec As Long mySec = 5 Application.Wait Now() + TimeSerial(0, 0, mySec) MsgBox mySec & "秒　経過しました。" End Sub

メニューの項目を実行したら、その項目にチェックマークを付けます。
サンプルではテスト1とテスト2をそれぞれ実行し、実行後に項目の先頭にチェックマークが付きます。
必ずファイルオープン時に、メニューバーに自作マクロを追加し、ファイルをクローズするときに元の状態に戻してください。
解除を忘れると、いつまでもメニューバーに残りっぱなしになってしまいます。

Option Explicit Const BarName As String = "Worksheet Menu Bar" Public Sub AddMenu() '********************************************************** '　　メニューバーに追加する '********************************************************** Dim myMenu As Variant Dim myMacro As Variant '新メニューを追加 Set myMenu = Application.CommandBars(BarName). _ Controls.Add(Type:=msoControlPopup) myMenu.Caption = "テスト(&T)" 'マクロ(1) Set myMacro = myMenu.Controls.Add With myMacro .Caption = "テスト1(&X)" .OnAction = "test1" End With 'マクロ(2) Set myMacro = myMenu.Controls.Add With myMacro .Caption = "テスト2(&Y)" .OnAction = "test2" End With End Sub Public Sub test1() '********************************************************** ' テスト1　マクロ '********************************************************** MsgBox "テスト1を実行しました。" With Application.CommandBars(BarName). _ Controls("テスト(&T)").Controls("テスト1(&X)") .State = Not .State End With End Sub Public Sub test2() '********************************************************** ' テスト2　マクロ '********************************************************** MsgBox "テスト2を実行しました。" With Application.CommandBars(BarName). _ Controls("テスト(&T)").Controls("テスト2(&Y)") .State = Not .State End With End Sub Public Sub ResetMenu() '********************************************************** ' メニューバーをリセットする（元の状態に戻す） '********************************************************** Application.CommandBars(BarName).Reset End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) '********************************************************** '　　メニューバーをリセットを呼び出す '********************************************************** ResetMenu End Sub Private Sub Workbook_Open() '********************************************************** '　　メニューバーに追加を呼び出す '********************************************************** AddMenu End Sub

マクロ作成者の立場から、必ず所定の手続きが完了しないと、ユーザーにExcelを（またはブックを）終了してほしくないという場合はありませんか？
サンプルではExcelの（またはシートの）×ボタンを無効にして、マクロからのみ終了できるようにしてあります。 （メニューバーの「ファイル」→「終了」からも終了できません）
終了させる場合は、必ずowaruプロシージャを呼び出して終了させます。
内容は簡単で、終了操作で生じるBeforeCloseイベントを検知したときに、こちらで用意した変数p_CloseがFalseの場合は引数CancelにTrueを設定することで、終了できなくしてあげればいいのです。
マクロからの終了処理時にのみ、p_CloseにTrueを代入して、終了無効判定にかからないようにしてあげます。

■ThisWorkbookに記述 Private Sub Workbook_BeforeClose(Cancel As Boolean) If Not p_Close Then MsgBox "終了できません" Cancel = True End If End Sub ■標準モジュールに記述 Public p_Close As Boolean Public Sub owaru() p_Close = True Application.Quit End Sub

ブックの各シートにたくさんのハイパーリンクを設定している場合に、そのアドレスを抽出するマクロです。
サンプルではイミディエイトウィンドウに表示していますが、ワークシート、テキストファイル等に落とすことも同様な方法でできますので、各自でアレンジしてみてください。

Public Sub GetHyperLink() Dim i As Integer Dim ws As Worksheet For Each ws In Worksheets For i = 1 To ws.Hyperlinks.Count Debug.Print ws.Hyperlinks(i).Address Next i Next ws End Sub

ブックを変更しないで閉じる場合は問題ありませんが、ブックに変更を加えて閉じる場合、Excelでは必ず変更を保存するかどうかを確認するメッセージが表示されます。 手動で操作する場合このメッセージは必要ですが、マクロで自動処理をさせるときは、このメッセージのために連続した動作が途切れるため、メッセージを出さずに次の処理に移るようにしたいケースがよく発生します。

保存確認のメッセージを出さない方法としては、2つのやり方が考えられます。
一つは、ブックに変更があってもなくても必ず保存してから閉じるようにするか、変更があってもシステムに変更がないように見せかけ、更新せずにそのまま閉じる方法です。
二つ目は名前を付けて保存する場合などで“既に同名のファイルがあるが置き換えるか”というようなメッセージが表示されますが、強制的にこのメッセージ表示をOFFにして、必ずファイルを置き換えて終了する方法です。
後者の場合、一時的に「Application.DisplayAlerts = False」にすることでメッセージの出力を抑制することができます。
サンプルはそれぞれの場合のブックの閉じ方の一例を挙げています。

※強制的に更新して閉じる Saveメソッド使用 Private Sub Workbook_BeforeClose(Cancel As Boolean) '強制的に更新して終了 ThisWorkbook.Save End Sub Closeメソッド使用 Public Sub Owari() '強制的に更新して閉じる ThisWorkbook.Close SaveChanges:=True End Sub ※更新しないで閉じる SavedプロパティをTrueに設定 Private Sub Workbook_BeforeClose(Cancel As Boolean) '更新しないで終了 ThisWorkbook.Saved = True End Sub Public Sub Owari() '更新しないで閉じる ThisWorkbook.Close SaveChanges:=False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) 'メッセージ表示を強制的にOFFにする場合 Application.DisplayAlerts = False ThisWorkbook.SaveAs "C:\closetest.xls" Application.DisplayAlerts = True End Sub Public Sub SaveHantei() 'クローズ時の自動判定 With ThisWorkbook If .Saved = True Then '更新していなければそのまま閉じる .Close SaveChanges:=False Else '更新していれば保存して閉じる .Close SaveChanges:=True End If End With End Sub

Worksheet_BeforeRightClickイベント実行時にセルのショートカットを表示させない方法です。
要はCancel = Trueで、右クリックイベントの発生を無効にしてあげればいいだけです。
MsgBox "RightClick"の部分に、実際に処理させたいコードを記述してください。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _ Cancel As Boolean) Cancel = True MsgBox "RightClick" End Sub