私が書いてきたプログラムは、ワークブックのさまざまなソースから情報を読み取り、情報を別のシートのいくつかのコンパクトなテーブルに再配置し、それらのテーブルを画像として別の要約シートにコピーします。このプログラムは、メイン プログラムによって呼び出されるいくつかの異なるサブルーチンとして作成しました。
メイン プログラムを実行すると、サマリー シートに貼り付けられる画像の寸法と配置は正しくなりますが、完全に白くなります。しかし、これらのイメージのコピーを担当するサブルーチンを実行すると、実際には正しいテーブルのコピーに成功します。テーブルを画像としてコピーして貼り付けるために使用しているコードは次のとおりです。
Sub ExtractToPresentation()
Call UnprotectAll
Application.DisplayAlerts = False
Application.CutCopyMode = False
startcell = Worksheets("Supplier Comparison").Cells(1, 1).Address
bottomcell = Worksheets("Supplier Comparison").Cells(21, 14).Address
Set copyrng = Worksheets("Supplier Comparison").Range(startcell, bottomcell) '.SpecialCells(xlCellTypeVisible)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(SupSt)
End With
サブルーチンは続きますが、残りは追加のテーブルごとに上記のコードのバリエーションです。
startcell = Worksheets("Rating Criteria").Cells(1, 1).Address
bottomcell = Worksheets("Rating Criteria").Cells(12, 7).Address
Set copyrng = Worksheets("Rating Criteria").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CritSt)
End With
startcell = Worksheets("Comments").Cells(1, 1).Address
bottomcell = Worksheets("Comments").Cells(4, 14).Address
Set copyrng = Worksheets("Comments").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CommSt)
End With
startcell = Worksheets("Component Table").Cells(1, 1).Address
bottomcell = Worksheets("Component Table").Cells(CompH, CompW).Address
Set copyrng = Worksheets("Component Table").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CompSt)
End With
Application.DisplayAlerts = False
Call ProtectAll
End Sub
St、H、および W で終わる変数は、各テーブルのサイズを決定する前のプログラムで定義されています。このプログラムが単独で完全に機能する理由はわかりませんが、他のプログラムの後に実行すると空白の画像が返されます。
私のコードの他の部分を見たい人がいたら教えてください。このプログラムには約 500 行あり、すべてを一度にダンプしたくありませんでした。