Worksheet.Copyメソッドの改良?

[Worksheet].Copyメソッドの改良?

[Worksheet].Copyメソッドについて、「オブジェクト ブラウザー」で調べてみると、

f:id:akashi_keirin:20190916105038j:plain

Sub、つまりvoidメソッドであることがわかる。

たぶん、プロがやったことなので、あえてvoidメソッドにしたことには意味があるのだとは思うが、なぜAddメソッドだとWorksheetオブジェクトを返すのに、Copyメソッドはそうしなかったのだろうか。

Copyメソッドで新たに生まれたシートをそのまま変数にぶち込めたら便利なのではなかろうか。

neoCopyメソッドの実装

……というわけで、neoCopyメソッドというものを考えた。

いや、単にシートをコピーした後、新しくできたシートを返す、というだけなんですけど。

難問

問題はどのように実装するか、である。

Worksheetクラスを継承してメソッドを付け足すだけ、とかだったらめっちゃ楽なんだが、残念ながらそういうことはできない。

一瞬、「Worksheetクラスを全部ラップしたクラス作ったらええやんけ」とも思ったのだが、Worksheetクラスのプロパティ、メソッド(その上イベントまである)の数のあまりの多さに早々に断念。

クラスモジュールを使うことも考えたが、シート自身を指し示す方法(*)が思い浮かばなかったので、やはり断念。

ここで言う「自分自身を指し示す方法」というのは、次のようなことです。

たとえば、PoweredSheetというクラスを作ったとして、次のような形でインスタンスを生成したとする。

Dim ps1 as PoweredSheet
Set ps1 = New PoweredSheet

このようなとき、PoweredSheetクラスがWorksheetクラスを継承していれば、通常のCopyメソッドを使用するとき、たとえば

Call ps1.Copy(After:=Worksheets(1))

のように書ける。っていうか、そうでないと意味がない。

しかしながら、継承が使えない以上、クラスモジュールでやろうとすると、(本家Worksheetクラスの全てのプロパティ・メソッドをラップしない限り)たとえば、シート自身を指し示すSelfみたいなプロパティを装着しておいて、

call ps1.Self.Copy

とでも書くしかない。

これでは、PoweredSheetをシートを表現するオブジェクトのように使うことはできない。

そこで、地道にシートモジュールにメソッドを追加することにした。

neoCopyメソッド

デフォルトのSheet1モジュールに次のコードを書いた。

リスト1 シートモジュール Sheet1
Public Function neoCopy( _
   Optional ByVal Before As Worksheet, _
   Optional ByVal After As Worksheet) As Worksheet  '……(1)'
  Dim ret As Worksheet
  Set ret = Nothing
  On Error GoTo Finalizer  '……(2)'
  If Before Is Nothing And _
     After Is Nothing Then Set Before = Me  '……(3)'
  Dim baseIndex As Long    '……(4)'
  With ThisWorkbook
    If Not Before Is Nothing Then
      Call Me.Copy(Before:=Before)
      baseIndex = getSheetIndex(Me)  '……(5)'
      Set ret = .Worksheets(baseIndex - 1)  '……(7)'
    Else
      Call Me.Copy(After:=After)
      baseIndex = getSheetIndex(Me)
      Set ret = .Worksheets(baseIndex + 1)
    End If
  End With
Finalizer:
  If Err.Number > 0 Then Call Err.Clear  '……(8)'
  Set neoCopy = ret  '……(9)'
End Function

Private Function getSheetIndex( _
             ByVal targetSheet As Worksheet) As Long  '……(6)'
  Dim ret As Long
  Dim i As Long
  With ThisWorkbook
  For i = 1 To .Worksheets.Count
    If .Worksheets(i).Name = targetSheet.Name Then
      ret = i: Exit For
    End If
  Next
  End With
  getSheetIndex = ret
End Function

まず、(1)の

Public Function neoCopy( _
   Optional ByVal Before As Worksheet, _
   Optional ByVal After As Worksheet) As Worksheet

で引数と返り値の設定。

引数は本家Copyメソッドと同じ。返り値をWorksheet型にしたのが今回のポイント。

引数に矛盾があるときのチェック用メソッドも書こうかなあとは思ったが、めんどくさいので、(2)の

On Error GoTo Finalizer

で、エラーが出たらNothingを返すようにした。

(3)の

If Before Is Nothing And _
     After Is Nothing Then Set Before = Me

は、引数が両方省略されていた場合の対応。

とりあえずBeforeに自分自身を渡すようにした。

(4)の

Dim baseIndex As Long
With ThisWorkbook
  If Not Before Is Nothing Then
    Call Me.Copy(Before:=Before)
    baseIndex = getSheetIndex(Me)  '……(5)'
    Set ret = .Worksheets(baseIndex - 1)  '……(7)'
  Else
    Call Me.Copy(After:=After)
    baseIndex = getSheetIndex(Me)
    Set ret = .Worksheets(baseIndex + 1)
  End If
End With

でコピーしてできた新しいシートを変数にぶち込むところまでやる。

引数Beforeがあるときは、それに従う。

本家Copyメソッドを実行した後、(5)の

baseIndex = getSheetIndex(Me)

でコピー元のシートのインデックス番号を取得する。

インデックス番号の取得には、外出しした(6)の

Private Function getSheetIndex( _
             ByVal targetSheet As Worksheet) As Long
  Dim ret As Long
  Dim i As Long
  With ThisWorkbook
  For i = 1 To .Worksheets.Count
    If .Worksheets(i).Name = targetSheet.Name Then
      ret = i: Exit For
    End If
  Next
  End With
  getSheetIndex = ret
End Function

を使う。

シートの名前を比較して、同じだったときのインデックス番号を返すだけ。

これで、コピー元シートのインデックスがわかるので、たとえば引数Beforeを指定して実行した場合ならば、一つ少ないインデックス番号がコピーしてできた新しいシートのインデックス番号、ということになる。

だから、(7)の

Set ret = .Worksheets(baseIndex - 1)

で、新しくできたシートを変数retにぶち込むことができる。

引数Afterを指定した場合も、処理の考えかたは同じなので説明は割愛。

あとは、もしエラーが出て飛んできているのなら、一応(8)の

If Err.Number > 0 Then Call Err.Clear

でエラーをクリアし、(9)の

Set neoCopy = ret

retの内容を返しておしまい。

使ってみる

まずは、

f:id:akashi_keirin:20190916105041j:plain

このようなブックを用意。

「Original」という名のシートが一つだけあり、A1セルに「ち~んw」というデータ(笑)が入力されている。

この状態で、次のコードで実行する。

スト2 標準モジュール
Private Sub testNeoCopy()
  Dim Sh As Worksheet
  Set Sh = Sheet1.neoCopy(After:=Sheet1)  '……(1)'
  If Sh Is Nothing Then _
    Call Provoke.makeUserSick("失敗www", mbiCritical): Exit Sub  '……(2)'
  With Sh    '……(3)'
    .Name = "Copied"
    .Range("A2").Value = "ち~んw"
  End With
End Sub

(1)の

Set Sh = Sheet1.neoCopy(After:=Sheet1)

neoCopyメソッドを使用。

Sheet1シートをコピーして、Sheet1シートの後ろに新しいシートを生み出す。

そして、生み出された新しいシートは変数Shにぶち込まれている。

(2)の

If Sh Is Nothing Then _
  Call Provoke.makeUserSick("失敗www", mbiCritical): Exit Sub

は気にしないでほしい。私は、ユーザーを煽るためのメソッドをProvokeと名づけた標準モジュールに集めており、インポートして使っている。

今回はそのProvokeモジュールのmakeUserSickを、neoCopyメソッドが失敗したとき(変数ShNothingが返ったとき)の対応に使っているだけだ。

Provokeモジュールについては、いつか紹介するときも来るだろう。

閑話休題

ここまでで、変数Shに新しく生み出されたシートがぶち込まれているので、(3)の

With Sh
  .Name = "Copied"
  .Range("A2").Value = "ち~んw"
End With

で新しいシートに手を加える。

シート名を「Copied」とし、A2セルに「ち~んw」というデータ(笑)を書き込む。

実行結果

スト2を実行すると、

f:id:akashi_keirin:20190916105045j:plain

こうなる。意図したとおり。

おわりに

問題は、全てのシートモジュールにいちいちneoCopyメソッドを搭載せねばならんことだ。

あまり役に立ちそうにない。

2019/10/26追記

リスト1では、返り値にするシート(コピーして出来たシート)を特定するのに、わざわざコピー元のシート名に基づいて探していた。

しかし、Copyメソッドを実行すると、コピーしてできたシートがActiveSheetになるのである。

何もあのようなややこしいやり方をする必要はなかったのではないか。

しかも、本家Copyメソッドの引数BeforeAfterは、ともにVariant型。もうこれらをそのままWorksheet.Copyに渡したら良いではないか。

こうした考えのもと、リスト1を書き改めた。

リスト1改 シートモジュール Sheet1
Public Function neoCopy( _
   Optional ByVal Before As Variant, _
   Optional ByVal After As Variant) As Worksheet
  Dim ret As Worksheet
  Set ret = Nothing
  On Error GoTo Finalizer
  Call Me.Copy(Before, After)
  Set ret = ActiveSheet
Finalizer:
  If Err.Number > 0 Then Call Err.Clear
  Set neoCopy = ret
End Function

劇的に短くなった。で、当然これでちゃんと動く。

やはり、公式リファレンスをちゃんと読まないとね。