エクセルVBAでの処理をエクセルVBAで複数回のアンドゥ・リドゥ(元に戻すとやり直し)を書いてみた

保存用シートにセルをコピペしておいて、もとに戻す処理でそこから元のシートにコピペという、かなり強引な力技での危険な疑似アンドゥ・リドゥ

 

マクロやVBAで処理したことに対してエクセルの元に戻す(Ctrl+z)ややり直しは使えない

事前に保存していなくて間違って実行したら手動で戻すしか無い

一歩間違えると自動実行が強制手動実行になってしまう、めんどくさい！

なので

マクロやVBAで実行した処理の結果に対して

複数回のアンドゥとリドゥ(戻すとやり直し)をするマクロを書いてみた

http://www.geocities.jp/gogowaten/excel_animation11.gif

元に戻せる回数を3回にした時の動作

起動すると保存用シートを3枚と一時保存シートを1枚作成する

終了時にはこれらのシートは削除される

元に戻すややり直しボタンの右の数値はそれぞれの実行できる回数

 

マクロやVBAで処理する前に対象となるセル範囲を保存用シートに

コピペと同時にコピペした場所も記憶してから

実行している

 

アンドゥ・リドゥ(元に戻す時ややり直し)の時は保存用シートからコピペしている

なのでアンドゥ・リドゥできるのはセルに対するマクロやVBAだけ

できないのはセル、シート、ブックなどの削除や追加するもの…グラフや図形もだな

 

ここまで書いて思ったのは

シートまるごとコピペしたほうが早かったかな…

 

使い道としては1枚のシートに対するマクロ用

セルの値や書式を変更するようなマクロ

そのセル範囲がわかっているもので

実行した直後に間違いに気づいた時

限定的だな

できあがった時はなかなかいいものができたなあって思ったんだけど

これ書いていたらイマイチな気がしてきたｗ

さらにエラーの処理も書いていないからちょっと変なことをするとエラーになる

 

今回も作るときにどんなふうになればいいのかエクセルを使って考えた

順番に操作を行った時にどの値がどのに保存されればいいのとか

アンドゥ・リドゥでどういう状態になればいいのか

難しかったのは保存先の決定の辺り

 

 

元に戻せる回数の指定は

Const wsCount As Long = 3 '保存用シートの枚数(元に戻せる回数)

UserForm1の最初の方に書いてある↑の数値が元に戻せる回数の指定なので

3回じゃ足りない時は増やせばいい、多くても100までくらいにした方がいい？

 

---

標準モジュール

'ユーザーフォームをModelessで表示する

'セルやシートを変更、クリックできる状態で表示する

Sub ufshow()

    UserForm1.Show vbModeless

    

End Sub

 

---

UserForm1のデザイン画面

4つのボタンと2つのラベルのそれぞれの名前

 

UserForm1に書いたマクロ

 

 

Dim TempSheet As Worksheet '一時的に値を保存するシート
Dim HOZONSheet() As Worksheet '保存用シートを入れる
Const wsCount As Long = 3 '保存用シートの枚数(元に戻せる回数)
Dim undoCount As Long '元に戻す用のカウント、0から3(0から保存シートの枚数)
Dim redoCount As Long 'やり直し用のカウント、0から3
Dim saveCount As Long '保存先シートの特定用、0から2(0から保存シートの枚数-1)
Dim ima As mySousa '今の操作の種類
Dim mae As mySousa '前回の操作の種類
Enum mySousa '操作の種類
    nasi = 0 '無し
    Sitei = 1 '指定
    iUndo = 2 '元に戻す
    iRedo = 3 'やり直し
End Enum
'保存するセルのアドレス記録用
Dim SAddress() As String, SSheetName() As String, SBookName() As String

'ユーザーフォーム起動時の処理
Private Sub UserForm_Initialize()
    '色々初期化
    mae = nasi '前回の操作の種類を「無し」にする
    undoCount = 0
    redoCount = 0
    Call urLabelラベル表示更新
    '配列の初期化
    ReDim SAddress(wsCount - 1)
    ReDim SSheetName(wsCount - 1)
    ReDim SBookName(wsCount - 1)
    ReDim HOZONSheet(wsCount - 1)
    saveCount = 0
    Dim nWS As Worksheet
    
    Application.ScreenUpdating = False '画面書き換えを一時無効
    'アンドゥ・リドゥ用シートを作成して配列に登録
    For i = 0 To wsCount - 1
        Set nWS = ThisWorkbook.Sheets.Add(Count:=1)
        nWS.Name = "保存" & i
        Set HOZONSheet(i) = nWS '登録
    Next
    
    '一時保存シート作成して変数に登録
    Set TempSheet = ThisWorkbook.Sheets.Add(Count:=1)
    TempSheet.Name = "一時保存"
    Application.ScreenUpdating = True '画面書き換えを有効に戻す
    
    'Sheet1を表示する
    ThisWorkbook.Worksheets("Sheet1").Activate
End Sub
'ユーザーフォーム終了時の処理
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False 'シート削除時のアラートを一時無効化
        
    'アンドゥ・リドゥ用シートと一時保存シートの削除
    For i = 0 To wsCount - 1
        HOZONSheet(i).Delete
    Next
    TempSheet.Delete
    
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
'指定ボタン
Private Sub CommandButton1_Click()
    Call myBefore前処理
    
    '目的の処理、ここから
    Dim r As Range
    Randomize
    For Each r In Selection
        r.Value = Int((10 - 0 + 1) * Rnd(10) - 0)
    Next
'    Selection.Value = ActiveCell.Value + 1
    '目的の処理、ここから
    
    Call myAfter後処理
End Sub
'指定ボタン、色を変える
Private Sub CommandButton4_Click()
    Call myBefore前処理
    
    '目的の処理、ここから
    Dim r As Range
    For Each r In Selection
        If r.Value >= 5 Then
            r.Interior.Color = RGB(255, 100, 100) '赤
        Else
            r.Interior.Color = xlNone '無し
        End If
    Next
'    Selection.Interior.Color = RGB(0, 0, 255) ' Selection.Interior.Color + 50
    '目的の処理、ここまで
    
    Call myAfter後処理
End Sub
'元に戻すボタン(アンドゥ)
Private Sub CommandButton2_Click()
    Call myUndoアンドゥ
End Sub
'やり直しボタン(リドゥ)
Private Sub CommandButton3_Click()
    Call myRedoリドゥ
End Sub

Sub saveAddressアドレスの記録()
    SAddress(saveCount) = Selection.Address
    SSheetName(saveCount) = ActiveSheet.Name
    SBookName(saveCount) = ActiveWorkbook.Name
End Sub
Sub toSaveSheet保存シートにコピペ()
    '選択セルを保存シートへコピペ、セルアドレスを揃える
    Dim r As Range
    Set r = HOZONSheet(saveCount).Range(SAddress(saveCount))
    Selection.Copy r ' 選択範囲を保存シートにコピペ
    Application.CutCopyMode = False 'コピー範囲の枠の点滅をやめる
End Sub
Sub uAndrアンドゥリドゥの処理()
    '保存シートからコピペ
    Dim hozonR As Range, tempR As Range
    Set hozonR = Workbooks(SBookName(saveCount)).Sheets(SSheetName(saveCount)).Range(SAddress(saveCount))
    'Set tempR = TempSheet.Range(Selection.Address)
    Set tempR = TempSheet.Range(SAddress(saveCount))
    'アンドゥ・リドゥする範囲を一時保存シートにコピペ
    hozonR.Copy tempR
    
    '保存シートから元の場所にコピペ
    HOZONSheet(saveCount).Range(SAddress(saveCount)).Copy hozonR
    
    '一時保存シートから保存シートにコピペ
    tempR.Copy HOZONSheet(saveCount).Range(SAddress(saveCount))
    'tempR.ClearContents '数式と文字の削除
    tempR.Clear '数式や文字、書式のクリア
    Application.CutCopyMode = False 'コピーの点滅をやめる
    
End Sub
Sub myセーブ場所選択()
    '今の操作と前回の操作からセーブする場所(シート)を決定する
    '場所(シート)は数値で管理0から数える、最大保存数が3なら0、1、2
    '0から使っていく、最大保存数を超えたら一番古いものに上書きしていく(012012012…)
    '今の操作と前回の操作が両方共アンドゥの時はカウントを戻す
    '今の操作と前回の操作のどちらかがアンドゥの時はカウントをそのままにする
    '最初の操作の時もそのまま
    'それ以外の時はカウント(場所)を進める(普通の操作やリドゥの時)
    
    '両方共アンドゥ
    If ima = iUndo And mae = iUndo Then
        If saveCount = 0 Then
            saveCount = wsCount - 1
        Else
            saveCount = saveCount - 1
        End If
    'どちらかがアンドゥ
    ElseIf ima = iUndo Or mae = iUndo Then
    '最初の操作だった
    ElseIf mae = nasi Then '一番最初なら0
        saveCount = 0
    'それ以外
    ElseIf saveCount < wsCount - 1 Then
        saveCount = saveCount + 1
    ElseIf saveCount >= wsCount - 1 Then
        saveCount = 0
    End If
    
End Sub

Sub urLabelラベル表示更新()
    Me.LabelRedo.Caption = redoCount
    Me.LabelUndo.Caption = undoCount
End Sub

Public Sub myBefore前処理()
    ima = Sitei
    Call myセーブ場所選択
    Call saveAddressアドレスの記録
    Call toSaveSheet保存シートにコピペ
End Sub
Public Sub myAfter後処理()
    If undoCount < wsCount Then
        undoCount = undoCount + 1
    End If
    
    redoCount = 0 'リドゥ回数をリセット
    Call urLabelラベル表示更新
    mae = Sitei
'    Application.OnUndo "test", "taskTest"
End Sub
Public Sub myUndoアンドゥ()
    If undoCount = 0 Then Exit Sub
    
    ima = iUndo
    Call myセーブ場所選択
    Call uAndrアンドゥリドゥの処理
    undoCount = undoCount - 1
    redoCount = redoCount + 1
    Call urLabelラベル表示更新
    mae = iUndo

End Sub
Public Sub myRedoリドゥ()
    If redoCount = 0 Then Exit Sub
    
    ima = iRedo
    Call myセーブ場所選択
    Call uAndrアンドゥリドゥの処理
    undoCount = undoCount + 1
    redoCount = redoCount - 1
    Call urLabelラベル表示更新
    mae = iRedo
End Sub

 

 

 

 

 

Call myBefore前処理

ここにアンドゥ・リドゥをしたい処理を書く

Call myAfter後処理

 

 

ダウンロード先

ファイル名：マクロで行った処理をマクロでアンドゥ・リドゥ.xlsm

OneDrive マクロで行った処理をマクロでアンドゥ・リドゥ.xlsm

エクセル2007 - OneDrive

 

マクロで行った処理をマクロでアンドゥ・リドゥ.xlsm(ヤフーボックス)

 

 

この記事のつづきは

gogowaten.hatenablog.com

エクセルVBAでの処理をエクセルVBAで複数回のアンドゥ・リドゥ(元に戻すとやり直し)を書いてみた、その2 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ

http://blogs.yahoo.co.jp/gogowaten/13104621.html

セル範囲じゃなくてシートごとコピペするようにした