may the VBA be with you

Excel VBAとか業務自動化とか

Excelでドット絵作成ツールを作る その7

はじめに

前回、

vba-belle-equipe.hatenablog.com

元に戻せるようにしました。

現状報告

f:id:vba-belle-equipe:20160513202334g:plain

こんな感じです。


履歴を複数残して「元に戻す」「やりなおす」をできるようにしました。

複数履歴

変更履歴シートに、縦に並べるような形でコピーして履歴を残しています。
(1履歴ごとにとりあえず10,000行)

重なってしまうことや、行が足りなくなることはそうそうないかなと思います。

コード

現時点でのコードは

'///標準モジュール///    <<mod00変更履歴>>

Option Explicit

Public Const TateHaba As Long = 10000   '1履歴に使う縦のセル数

'履歴保存
Sub saveHistory()
  Dim rg As Range
  Dim gyo As Long
  Application.ScreenUpdating = False
  CurHistory = CurHistory + 1
  CntHistory = CurHistory
  Call setCurHistory
  Set rg = Range(BaseRng.Offset(1, 1), Cells(BaseRng.Row + Tate, _
                          BaseRng.Column + Yoko))
  gyo = CurHistory * TateHaba + 1
  With Sheets("変更履歴")
    rg.Copy Destination:=.Cells(gyo, 1)   'コピー
    .Range(.Cells(gyo + Tate, 1), _
        .Cells(Rows.Count, Columns.Count)).Clear  'クリア
  End With
  Application.ScreenUpdating = True
End Sub

'元に戻す
Sub doUndo()
  Call setSettings    '設定を共通変数にセット
  If CurHistory <= 0 Then
    Exit Sub
  End If
  CurHistory = CurHistory - 1
  Call setCurHistory
  Call copyFromHistory
End Sub

'やり直し
Sub doRedo()
  Call setSettings    '設定を共通変数にセット
  If CurHistory >= CntHistory Then
    Exit Sub
  End If
  CurHistory = CurHistory + 1
  Call setCurHistory
  Call copyFromHistory
End Sub

'現在の表示が履歴のどの段階なのかを記録
Sub setCurHistory()
  Application.EnableEvents = False
  With Sheets("ドット絵作成")
    .Range(CurHistoryAddress) = CurHistory
    .Range(CntHistoryAddress) = CntHistory
  End With
  Application.EnableEvents = True
End Sub

Sub copyFromHistory()
  Dim rg As Range
  Dim Tgt As Range    '貼り付け前選択セル
  Dim gyo As Long
  gyo = CurHistory * TateHaba + 1
  With Sheets("変更履歴")
    Set rg = .Range(.Cells(gyo, 1), .Cells(gyo + Tate - 1, Yoko))
  End With
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  rg.Copy
  Sheets("ドット絵作成").Activate
  Set Tgt = Selection
  BaseRng.Offset(1, 1).Select
  ActiveSheet.Paste
  Tgt.Select
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

こんな感じです。

今回いじったのは履歴の部分だけでした。


今後の課題

ボタンを押せない時に、押せない感を出したいところです。
(ただの図形にマクロをくっつけているので、標準ではできない)

あと、画像出力だけではなくて、描画した部分を新しいブックに出力したりしたいかなと思います。