新しいYouTube動画投稿しました。

表計算の福音～エクセルでここまで出来る～VBA解説編の第３回目動画を投稿しました。今回のテーマは『マクロで失われたクリップボードを復元する』です。

サンプルエクセルをダウンロードするにはこちらから～
UndoCopy復元.xlsmのダウンロード (283 ダウンロード )

マクロで失われたクリップボードの復元とは

マクロでクリップボードが失われるとはどういうことでしょうか？エクセルの基本機能・ホームタブに「元に戻す」ボタンと「やり直し」ボタンがあります。これは誰もがエクセルを使い始めて最初のころに覚えるボタンだと思います。

ところが、VBAで書いたプログラムを実行するようになると、このボタンがいつの間にか使えなくなっている・無効化されていることに気づくのではないでしょうか？それだけでなく、セル範囲をコピーして、貼り付けしようと、貼り付け先のセルを選択すると貼り付けボタンが無効化されていることに気づくことってないですか？

これは、ユーザーが、セルに対してある入力をした時や、セル選択を変更した（移動した）時に、Worksheet_Changeや、Worksheet_SelectionChangeイベントプロシージャが走り、このためクリップボードの記録が無効化されてしまうためです。

マクロが走ったその瞬間に、クリップボードが自己防衛としてなのか、それまで保持していた値を放棄して、自ら無効化してしまうために、コピーしていた値も消えてしまうし、直近のユーザー入力による変更履歴も消えてしまいます。

ネットでみると、これに関連した質問などをする人も結構いるみたいで、困っているひとは多いんじゃないでしょうか？　ネット上のこの種の質問には、「マクロの取り消しは出来ない」というような趣旨の回答が多いようです。

VBAプログラムで操作した処理自体をUndo・取り消し・リバート（Revert）することがどうしても必要なら、そのプログラムを組んだ人が元に戻すプログラムを書くしかないですね。プログラム実行後にその取消しが必要な場合が予想しうるなら、それは開発者としては用意しておくべきだと思います。

ただ、ここで取り上げるのはそのことではありません。それとは少し違った問題です。

マクロの取り消しではなく、その直前に行ったユーザーによる操作の取り消し

それはVBAマクロで実行してしまった処理を取消したいのではなく、マクロが走ったとばっちりを受けて、ユーザーがその前に行った操作（つまりセルへの値の入力）を、もとに戻すこともできなくなってしまうのは困るよ、という声です。ユーザーからは当然「ExcelなんだったらなんでUndoできないの？」という声は出てきますよね。

そこで、ある一定の条件付きではありますが、Undo（元に戻す）、Redo（やり直す）、コピペがエクセル標準機能では無効化されてしまっていても実行できるようにする方法をご紹介したいと思います。それをここでは『失われたUndo,Redo,CopyPaste機能を復元する』というふうに表現しています。

「ある一定の条件付き」では、と言いましたが、その条件とは何かをまずご説明したいと思います。

• 第１に、マクロによる処理を元に戻すのではなく、ユーザーが行った単一セルまたは複数セルからなるレンジへの値入力・値変更を、変更前に戻したり、戻したものを再度やり直したりする、という意味でのUndo,Redoに限られる、ということです。先ほど述べたように、マクロによる処理を元に戻すのは、必要なら（あくまで必要ならですが）開発者がそれとして用意しておくのが前提ですからここでは対象外とします。

• 第２に、元に戻したり、やり直したり、コピペしたりするのはあくまで値（Value）として、のみであって、Formulaや書式は対象外ということです。『購買くん』のように、業務システムの一部としてのExcelVBAという場合、大体はユーザーに許可されているのは、設計された特定の入力フィールド（つまりセルまたはレンジ）への値の更新だと思います。画面（つまりシート）の入力フィールド以外の部分は多くの場合保護されていてユーザーはどのみち触れませんし、ユーザー入力を意図したフィールドのセルにExcelの関数・数式が入っているというのもレアなケースだと思います。また書式はシステムのUIとして開発者ががっちりデザインし画面に固定されているのであって、それをユーザーが変更できるという想定は考えにくいです。

• 第３の条件は、やり直しやコピペの対象レンジはある程度狭い範囲のレンジであり、例えば何千行もあるシート全体とか、を対象にはしない、ということです。条件②で述べましたように、業務システムUI画面のユーザー入力フィールドだけを対象にするということから、ある程度限られた広さのターゲットであることは想定されると思います。

さて、以上のような条件内でUndo・Redo・コピペをどのように復元するのかを次に解説していきたいと思います。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

復元機能を実装したブック（VBAコード入り）をダウンロードしたい方は、ここからダウンロードお願いします。

UndoCopy復元.xlsmのダウンロード (283 ダウンロード )

以下その説明となります。

Undo, Redo, Copy, Pasteボタンが作ってあります。

まず、Undo・Redoについて説明します。

ユーザー入力を元に戻すために必要なこと

当然といえば当然ですが、ユーザー入力を元に戻すには、二つのことが必要です。

1. ユーザーによる変更前の値
2. ユーザーが変更したセル範囲のアドレス

一つ目ですが、ユーザーによる変更前の値がどこかに記録されていなければなりません。ユーザー入力はWorksheet_Changeイベントの発生で初めて把握されます。ところがWorksheet_Changeイベントが発生した時には、変更前の値は既に上書きされてしまっており、変更前の値を取得するには手遅れです。

そうなるとユーザーが変更する前の値を、イベントとしてキャッチできるタイミングはユーザーがセルまたはセル範囲を選択した時しかありません。つまりWorksheet_SelectionChangeイベント発生時です。そのイベントプロシージャで今選択されたセル範囲の値を一旦保管しなければなりません。前にお話しした制約条件のように、元に戻す対象はユーザーが手で入力したものだけです。VBAコードによって直接値がどこかのレンジに書き込まれるような変更は対象ではありません。したがって原則としてユーザー入力に必ず先立って入力対象のセル範囲が選択されているはずです。よってWorksheet_SelectionChange イベント発生時にその時点のセル範囲の値を保管しておくことは有効な準備となります。

変更前の値をどこに保管しておくのがいいか

ではそれを保管する箱・入れ物として、クリップボード以外で何が考えられるでしょうか？ワークシートが思い浮かぶと思います。ユーザーが使うワークシートとは別にシステム用のワークシートを持ち、そこに保管する案です。しかしこの案の不利な点はワークシートへの書き込みは処理速度というコストが非常に高いことです。セルへの書き込みはエクセルVBAのなかでは最も処理速度コストが高いものの一つです。

では第2案としてPublic変数に格納する、というのはどうでしょうか？Publicだから大丈夫だろうと思っていると、ところが、Public変数にも有効期限がある？のかどうかわかりませんが、Public変数の値がしばしば消えるというのはよくあるようです。

Public宣言された変数に有効期間がある落とし穴

VBAで標準モジュールにPublic変数を宣言、またはPrivate変数を宣言してPublicプロシージャで値を書き換える処理を構築した場合、予期せず、変数に格納したはずの値がクリアされることがありま

k-sugi.sakura.ne.jp

そこで第３案ですが、ユーザーフォームをひとつ作り、そのなかのテキストボックスに書き込んで保管する方法です。この方がセル書き込みより格段に速いですし、消える確率も小さいです。

一方、変更が起こったセルアドレスですが、変更前の値とセットで保管が必要です。その場合、Undoを同一ブック内に限定するとすれば、シート名とセル範囲アドレスの二つを保管しておく必要があります。アプリケーション内とするなら、ブック名も記録が必要です。

Worksheet_SelectionChangeが起こっても、そこでユーザーが値の変更をするとはかぎりませんから、しなかった場合はこの記録は空振りというか、無駄になりますが、それは仕方がありません。

さてユーザー選択のセル範囲が複数セルの場合、その値すべてをテキストボックスに保管するにはどうしたらいいでしょうか？それにはクリップボードを経由するのが一番いいと思います。つまり、

これで選択範囲全部の値が一つのテキストボックスtbValueNowに格納され、そのアドレスがtbAddrNowに格納されます。ここでクリップボードはデータの保管場所ではなく、単なる一瞬の経由ルートとして扱われていることにご注意ください。

ユーザーがセル選択を変更するたびにWorksheet_SelectionChangeイベントプロシージャが足りそれが下記プロシージャを呼び出します。

Sub MySelectionChange(Target As Range) ‘レンジSelectionが変更されたら
　　Application.ScreenUpdating = False
　　Target.Copy
　　With UserForm1.tbValueNow ‘とにかくその位置と値をクリップボード経由でTextBoxに格納
　　　　If .CanPaste = True Then
　　　　　　.Value = “”
　　　　　　.Paste
　　　　　　.Value = AdjustedValue(.Value, Target)
　　　　End If
　　End With
　　Application.CutCopyMode = False
　　Application.ScreenUpdating = True
　　UserForm1.tbAddrNow.Value = ActiveSheet.Name & “!” & Target.Address(0, 0)
End Sub

さて、今度はユーザーがセル選択を変更した後、実際にそこで値の変更を行ったときのWorksheet_Changeイベントです。そのときはじめて変更履歴用のテキストボックスに変更される前のValueと、そのアドレスを最初の履歴ボックスであるtbHistValue1, tbHistAddr1に格納します。具体的にはtbValueNowとtbAddrNowの値をテキストボックス間でコピーするわけです。このMyChangeというプロシージャがそれを行っています。

Sub MyChange(Target As Range) ‘ユーザーによる値の変更があったら
　　With UserForm1
　　　　If .tbNextUndo <> “0” Then ‘Undo途中の場合は、履歴をリセットし履歴をそこから記録開始する
　　　　　　Call ResetHistory
　　　　End If
　　　　Call InsertHist ‘履歴に記録
　　　　.tbNextUndo.Value = 0
　　End With
End Sub

さてユーザー入力の履歴を何階層まで記録しておくかは使用するユーザーのニーズによりますが、このサンプルでは５階層までとしました。６回目の変更が起こると１回目の変更記録ボックスからまた始めて、使いまわしていきます。このためどのボックスが一番新しい記録なのかを記録しておく必要があり、tbSeqというボックスにそれがあります。tbSeqは最初は１で、次に、１２，１２３，１２３４，１２３４５と変化していき、次に５１２３４、４５１２３となります。tbSeqを更新しているのは、このNewSeqというFunctionになります。

Function NewSeq(MySeq As String) As String
　　Dim InsPos As Integer
　　If Len(MySeq) < 5 Then
　　　　InsPos = Len(MySeq) + 1
　　　　NewSeq = MySeq & Trim(Str(InsPos))
　　Else
　　　　InsPos = InStr(MySeq, “1”)
　　　　Select Case Left(MySeq, 1)
　　　　Case “5”
　　　　　　NewSeq = “45123”
　　　　Case “4”
　　　　　　NewSeq = “34512”
　　　　Case “3”
　　　　　　NewSeq = “23451”
　　　　Case “2”
　　　　　　NewSeq = “12345”
　　　　Case “1”
　　　　　　NewSeq = “51234”
　　　　End Select
　　End If
End Function

さて、ユーザーがUndoボタンを押したら、記録してあるデータをtbHistValue1~5から新しい順に取り出して、それを元あったセルアドレスに書き戻してやる必要があります。それを実行しているのがこのMyUndoプロシージャです。書き戻すときも同様にクリップボードを経由します。変更前Valueを保管中のtbHistValueからCopyメソッドでいったんクリップボードにコピーし、その後すぐセル範囲にPasteメソッドで貼り付けます。

書き戻してやったら、すぐに今度は今まで変更前の値を格納していたtbHistValueのテキストボックスに、書き戻す前にセルに入っていた値を替わりに格納してやる必要があります。それはどこにあるかというと、tbValueNowにあります。ここではつまり、テキストボックスにあるひとつ前の値と、現在の選択範囲にあるセルの値を入れ替えているのと同じです。

Sub myUndo()
　　Dim Target As Range, Sh As Worksheet, TargetAddr As String, i As Integer, iInSeq As String
　　Dim myMapAr As Variant, TargetValue As String

　　myMapAr = Mapping                           '履歴を格納するTBをマップし配列に格納する
　　With UserForm1
    　　i = Val(.tbNextUndo.Value)              'i=次のUndo対象
    　　If i = 99 Then                          '99なら最後までUndo実行済
        　　Exit Sub
    　　ElseIf i = 0 Then                       'Undoがまだ行われていない
        　　i = .tbLastUserChange.Value
        　　If i = "0" Then Exit Sub
    　　End If
    　　iInSeq = InStr(.tbSeq, i)               'Undo対象が、Map配列の何番目のTBか把握
　　End With

　　Dim pos As Integer
　　TargetAddr = myMapAr(iInSeq, 1).Value
　　TargetValue = myMapAr(iInSeq, 2).Value

　　pos = InStrRev(TargetAddr, "!")             '対象アドレスをシート名とアドレスに分ける
　　Set Sh = Sheets(Left(TargetAddr, pos - 1))
　　Set Target = Sh.Range(Mid(TargetAddr, pos + 1))
　　Sh.Activate
　　If TargetAddr = ActiveSheet.Name & "!" & Selection.Address(0, 0) Then
    　　Call MySelectionChange(Target)
　　Else
    　　Target.Select                               'Undo対象レンジを選択
　　End If
　　With myMapAr(iInSeq, 2)                         'そのレンジの旧値を保持しているTextBoxについて
    　　.SelStart = 0
    　　.SelLength = .TextLength
    　　Application.EnableEvents = False
    　　If .SelLength > 0 Then
        　　.Copy                                   '旧値をCBにCopyして
        　　DoEvents
        　　Sleep 1
        　　DoEvents
        　　Sh.Paste Destination:=ActiveCell            '対象レンジに貼り付け①
    Else
        Target.Value = ""
    End If
    Application.EnableEvents = True
    .Value = UserForm1.tbValueNow.Value         '対象レンジに貼り付ける前（①の前）の値をmyTbValueにセット
                                                '＝これで対象レンジの新旧の値が入れ替わった
    Call MySelectionChange(Target)
End With
If i = 1 Then
    UserForm1.tbNextUndo.Value = 99             '今Undoしたのが最古だった場合はUndoは打ち止め＝99
Else
    UserForm1.tbNextUndo.Value = i - 1
End If

End Sub

これに対して、Redo（やり直し）の場合はUndoによって裏返されたオセロを、元に戻すように再度ひっくり返していく操作です。Undoで行ったテキストボックスの値とセルの現有の値の入れ替えと同じことを、再び行って元に戻すわけです。

一番最後にUndoされたものを最初にRedoします。

さて、過去５つの変更の内３回分の変更を元に戻したとします。この段階でユーザーが独自に、新たな入力操作をしたとします。この場合は、今の入力操作を初回操作として履歴を振り出しに戻します。これがResetHistoryプロシージャとなります。

Sub ResetHistory()
　　With UserForm1
　　　　Dim myMapAr As Variant, i As Integer
　　　　myMapAr = Mapping
　　　　For i = 1 To 5
　　　　　　myMapAr(i, 1).Value = “”
　　　　　　myMapAr(i, 2).Value = “”
　　　　Next i
　　　　.tbNextUndo.Value = 0
　　　　.tbLastUserChange = 0
　　　　.tbSeq = “”
　　End With
End Sub

以上の解説を踏まえて、実際に入力やUndo,Redoをやってみます。それで、各テキストボックスの値が

以上、UndoとRedoについて解説しました。次にCopy、Paste機能についてお話します。

＊＊＊＊＊＊＊Copy,Paste＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Copy,Pasteについてもクリップボードの自己防衛で普通のPasteが効かないので、独力で作りこんでやる必要があります。Userform1にtbCbValueというテキストボックスが用意されています。

Sub myCopy()
　　With ActiveWindow.RangeSelection
　　　　If .Areas.Count > 1 Then
　　　　　　MsgBox “離れたセル範囲のコピーは出来ません”
　　　　　　Exit Sub
　　　　End If
　　　　.Copy
　　　　UserForm1.tbSourceAddr.Value = .Address(0, 0)
　　End With
　　With UserForm1.tbCbValue ‘値をクリップボード経由でTextBoxに格納
　　　　If .CanPaste = True Then
　　　　　　.Value = “”
　　　　　　.Paste
　　　　End If
　　End With
End Sub

自家製Copyボタンを押すと、先ほどと同様に、クリップボード経由でテキストボックスに値がコピーされます。今回はコピーモードになることを隠す必要はないので、ボタンを押すと一度はコピーモードになります。

さて、ユーザーがPasteボタンを押したときのプロシージャはこちらのMyPasteです。

Sub myPaste()
　　TargetRng.Select
　　’貼り付け先のレンジをあらかじめSelectすることにより、tbValueNowに貼り付け前の値を保存する（この後ユーザーがUndoしたときのため）
　　With UserForm1.tbCbValue
　　　　Dim myStr As String
　　　　myStr = .Value
　　　　.SelStart = 0
　　　　.SelLength = .TextLength
　　　　If .SelLength > 0 Then
　　　　　　.Copy
　　　　　　ActiveSheet.Paste Destination:=ActiveCell
　　　　Else
　　　　　　ActiveCell.Value = “”
　　　　End If
　　End With
End Sub

さて、貼り付けをすることもユーザーによる操作ですので、Undoの対象になるべきですね。したがって貼り付け前に、その貼り付け対象レンジを正確にSelectして、MySelectionChangeプロシージャを発動して貼り付け前のレンジの値を記録しておかなければなりません。貼り付け自体はそのレンジの正確なサイズを知る必要はなく、ActiveCell一つの指定だけでできますが、このことのために貼り付けレンジの大きさを把握する必要があります。

そこでコピーしたときに、その対象範囲を記録しておき、同じ行列のサイズをもつレンジを、今度は貼り付け先のアクティブセルを左上に持つコピー元と同サイズの範囲を一旦選択し、貼り付け直前の値をユーザーフォームに記録しておいた上で、貼り付けを行っています。

さて、ここで一つ問題があるのですが、貼り付け対象範囲が全部または一部がブランクのセルであった場合、クリップボード経由でその値をテキストボックスに貼り付けたとき、ブランクの部分がオミットされてしまうことがあります。これが起こるのは対象範囲の下側だったり、右側だったりしますが、どのようなときにそうなるかという法則性を完全には把握できません。

一部が欠落して値が記録されていると、今度はそれをUndoするときに一部しかUndoされないことが起こってしまいますので、テキストボックスに書き込むときにその補正をしておく必要があります。

そのために、セル範囲の値がクリップボードに記録され、そのテキストデータがテキストボックスに書き込まれるときどのようなフォーマットを取るかを理解しておく必要があります。

左右のセル同士の間にはタブ記号が入ります。行の最後には必ず改行コードが挿入されます。このことから、あるべき行数、列数にはタブ記号が何個含まれ、改行記号が何個含まれていなければおかしい、ということがわかります。対象レンジの行列サイズはわかっていますから、それに見合った記号のあるべき数との差を計算することによって、セル範囲の下側末尾の行数、右側末尾の列数でオミットされている部分が割り出されます。その分のタブ記号、改行記号をテキストデータに加えてやる必要があります。

その補正を行っているのがこの部分となります。

Function AdjustedValue(myValue As String, Target As Range) As String
　　Dim c As Integer, r As Integer, AddStr As String, MissingRowCnt As Long, i As Long, MissingColCnt As Long

　　c = Target.Columns.Count
　　If CountStr(myValue, Chr(13)) < Target.Rows.Count Then
    　　MissingRowCnt = Target.Rows.Count - CountStr(myValue, Chr(13))
    　　AddStr = myValue & String(c - 1, Chr(9)) & Chr(13) & Chr(10)
    　　For i = 1 To MissingRowCnt
        　　myValue = myValue & AddStr
    　　Next i
　　End If
　　r = Target.Rows.Count
　　If CountStr(myValue, Chr(9)) < r * (c - 1) Then
    　　MissingColCnt = r * (c - 1) - CountStr(myValue, Chr(9))
    　　MissingColCnt = MissingColCnt / r
    　　myValue = Replace(myValue, Chr(13) & Chr(10), String(MissingColCnt, Chr(9)) & Chr(13) & Chr(10))
　　End If
　　AdjustedValue = myValue

End Function

現状テキストデータのmyValueと、あるべきレンジサイズのTargetを引数としてわたし、以上の解析を行って正しい補正を加味したテキストデータを返しています。

この前提には、クリップボードを経由してテキストボックスに複数セルの値を貼り付けたとき、そのテキストには一定のフォーマットルールがあるということです。

そのフォーマットとは：

• セルの値とその左右隣のセルの値の間にvbTabが１文字挿入される
• 行の終わりにはvbCrLf (vbCr & vbLf)が挿入される

したがって、いまからテキストボックスに保管していた値をセル範囲に書き戻そうとするとき、保管している文字列に含まれるvbTabとvbCrLfの数を数えると何行何列の範囲に書き戻すのかを事前に知ることができます。

それをやっているのがこのコードの部分です。

Function CountStr(myStr As String, CntWhat As String) As Integer
　　CountStr = Len(myStr) – Len(Replace(myStr, CntWhat, “”))
End Function

最後に一つだけ付け加えます。コピーペースト、Undo,Redoくらいメジャーなエクセルコマンドだと、ショートカットキーを使う人が多いかもしれません。そこで、同じキーをこの自家製プロシージャに結び付ける方法をご紹介します。

Sub myShortcutKey()
　　Application.OnKey “^c”, “myCopy”
　　Application.OnKey “^v”, “myPaste”
　　Application.OnKey “^z”, “myUndo”
　　Application.OnKey “^y”, “myRedo”
End Sub
Sub myCancelShortcutKey()
　　Application.OnKey “^c”
　　Application.OnKey “^v”
　　Application.OnKey “^z”
　　Application.OnKey “^y”
End Sub