EXCELのカメラ機能の代替

質問

元々の目的は、以前より使っていた日々の報告書のEXCELシートを現在のレイアウトや構成のままで押印欄のみをカメラ機能を使って変更可能にしようとしました。
表示については結果は思った通りではあったものの、計算式の有無に関わらずセルに入力するたびに3～5秒待たされるという予想外な問題点が解り、何か代替の方法はないかと模索しております。
良い方法がありましたらご指南ください。

元々の報告書EXCELの特徴としては

１）1ファイルには１ヶ月１シートとして12か月分のシートがある
２）１シートには28日～31日分の報告書が縦に並べられている。※互いに集計などが入っているので元々重いが、計算式のない所は特に問題ない程度の挙動(重く感じない)だった
３）複数拠点で同一のフォーマットを使っているが押印欄のみ異なっていた

この為、３）の理由から拠点ごとにいちいちファイルを分けて作る必要があり、ファイル自体も個人単位で利用する為、利用者が人事異動が発生するとその都度残りの日数分の押印欄を手で差し替える必要があるというものでした。
その問題を解消するため、拠点を書き換えるだけで押印欄の回覧先が変化するようにカメラ機能を使って追加したわけですが、結果的に重さが以前よりも増し、利用できないレベルに陥ってしまっております。
※その為、カメラ機能で貼り付けられたオブジェクトは全部で365か所となります。
※最終手段としてはテキストボックスの組み合わせで枠を作り、そこに回覧先を値としてリンクさせるという方法しかないのかもしれませんが…

根本的な点や作りが悪いのも承知しているのですが、3月19日までには改修完了しなくてはならず、そのくせそれにばかり時間をかけられないということもあり、再検討や新しく作りかえが不可能な為、何か良い代替案があればぜひともお教え願います。

慌てている為、乱文かとおもいますが、ご容赦ください。
以上、よろしくお願いいたします。

回答No.2

mitarashi · ベストアンサー

#1です。舌の根も乾かないうちにというか、見直してみるとsh.Activateの位置が変でした。お恥ずかしい限りです。
また、多数のシート及び図があると、速度に影響するかもしれませんので、画面の更新停止も盛り込んでみました。
差し替え願います。

Sub test()
Dim shp As Shape
Dim sh As Worksheet
Dim shpAddress As String

Application.ScreenUpdating = False
Worksheets("Sheet1").Range("A1:D6").CopyPicture Appearance:=xlScreen, Format:=xlPicture
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Sheet1" Then
sh.Activate
For Each shp In sh.Shapes
shpAddress = shp.TopLeftCell.Address
shp.Delete
sh.Range(shpAddress).Activate
ActiveSheet.Paste
Next shp
End If
Next sh
Application.ScreenUpdating = True
End Sub

お礼

おお、とてもいい感じです。
更新の処理には時間はかかりましたが(３６５個分なので当然ですが３０分くらい)、操作はマクロ実行用ボタン一つ用意しておけばそれぞれの利用者でできるレベルなので何とかなりそうです。
(30分程度で済めば以前使っていたシートでの移行方法(一個ずつつコピペ)よりは早いので)
その後の挙動は待ち時間もなくなりすっきり動く感じに戻りました。
また、以前の(カメラ機能を使う前の)作り方では複数の図形(テキストボックス含む)だったからなのか、ファイルサイズも大きかったのですが、このやり方ならファイルサイズも３分の１近くまでなり、配布時のサイズ軽減という副次的効果もありました。
あとは若干のカスタマイズと位置合わせの問題をクリアする必要はありますが、これはうまく調整してやってみようと思います。
本当に感謝です。
どうもありがとうございます。

補足

回答ありがとうございます。
昨日は都合で不在だったため、返事遅くなり申し訳ありません。
ソースまで用意いただき助かります。
この用意していただいたVBAを使った方法、これから試してみます。

回答No.1

mitarashi

カメラ機能は、月報（Ａ４一枚）に無理矢理各種表を入れ込むのに１回/月使う程度で、特に不都合も感じていませんでしたが、ご質問を見て調べてみると、相当重い代物らしいですね。最近のバージョンではどうか分かりませんが、VBAの実行をとんでもなく遅くする事がある事もお陰様で知りました。（開いている他のブックに存在するだけで、他のブックまで重くなる）
http://okwave.jp/qa/q3383892.html

マクロで、人事異動があった際に、人間様がトリガをおこして各押印欄のセルを書き換えるか、レイアウト上困難ならリンク無しの図として貼り付けるかしかないと思います。

後者の例を試しにやってみました。
前提条件
コピー元の捺印欄が、Sheet1のA1: D6にある
こちらを編集後、他の全シートの、リンク無しで図として貼り付けた、既存の図を置き換える
既存の図は、図として貼付後、サイズをいじってないこと、セルの左上隅と図の左上隅の位置を合わせて貼り付けてある事を前提にしています。
また、他にオートシェイプや、図が無いこと。セルのコメントや、写真等も図にあたります。
懸念事項：図を多数削除しては新規生成しているので、ある時期図形の内部的な管理番号が上限に達して動かなくなる事があるかもしれません。数百回は大丈夫だと思いますが。
少数の図及びシートでの試験しか出来ていませんが、ご参考までに。なお当方xl2000です。（xl2010機故障中）

Sub test()
Dim shp As Shape
Dim sh As Worksheet
Dim shpAddress As String

Worksheets("Sheet1").Range("A1:D6").CopyPicture Appearance:=xlScreen, Format:=xlPicture
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Sheet1" Then
For Each shp In sh.Shapes
shpAddress = shp.TopLeftCell.Address
shp.Delete
sh.Activate
sh.Range(shpAddress).Activate
ActiveSheet.Paste
Next shp
End If
Next sh
End Sub

お礼

お礼とクローズをしてしまった為、#2の方に書き込めないのでこちらに追加補足です。
お陰さまで、昨日時点でほぼ完成形になりました。
先般書き込みました「３０分ほどかかる」点については、カメラ機能を使って表示していたところを全て置き換えてから処理したところ、EXCEL2003,2007,2010の環境上で約３０秒～１分前後くらいで更新が可能になりました。
以前の挙動から比べるとかなりの軽量&処理速度向上となりました。
改めてお礼を申し上げます。