Worksheet.Copyメソッドの改良?
[Worksheet].Copyメソッドの改良?
[Worksheet].Copy
メソッドについて、「オブジェクト ブラウザー」で調べてみると、
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
の内容を返しておしまい。
使ってみる
まずは、
このようなブックを用意。
「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
メソッドが失敗したとき(変数Sh
にNothing
が返ったとき)の対応に使っているだけだ。
Provoke
モジュールについては、いつか紹介するときも来るだろう。
閑話休題。
ここまでで、変数Sh
に新しく生み出されたシートがぶち込まれているので、(3)の
With Sh .Name = "Copied" .Range("A2").Value = "ち~んw" End With
で新しいシートに手を加える。
シート名を「Copied」とし、A2セルに「ち~んw」というデータ(笑)を書き込む。
実行結果
リスト2を実行すると、
こうなる。意図したとおり。
おわりに
問題は、全てのシートモジュールにいちいちneoCopy
メソッドを搭載せねばならんことだ。
あまり役に立ちそうにない。
2019/10/26追記
リスト1では、返り値にするシート(コピーして出来たシート)を特定するのに、わざわざコピー元のシート名に基づいて探していた。
しかし、Copy
メソッドを実行すると、コピーしてできたシートがActiveSheet
になるのである。
何もあのようなややこしいやり方をする必要はなかったのではないか。
しかも、本家Copy
メソッドの引数Before
、After
は、ともに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
劇的に短くなった。で、当然これでちゃんと動く。
やはり、公式リファレンスをちゃんと読まないとね。