エクセル2003・複数のブックに図形をコピーしたい

質問

ブックが200位あります。
次の３点についてご教示お願いします。
1.すべてのブックのsheet1に図形をコピーしたい
2.すべてのブックのsheet2とsheet3を削除したい
3.すべてのブックのsheet1に保護をかけたい
なお、すべてのブックのsheet名は同じです。
1つだけでも教えていただければ幸いです。よろしくお願いします。

回答No.4

Prome_Lin · ベストアンサー

またまた、遅くなり、申し訳ございません。

「インデックスが有効範囲にありません」が出るのは、
ワードの図形を保存するときではなく、
私のプログラムを実行するときに起こるのですよね？

このエラーは、例えば、シートが２つしか無いのに、
「Sheet3」を指定した場合に起こります。

私のプログラムでは、「Sheet2」と「Sheet3」が
必ず存在する前提でしたので、逐一、
「Sheet2」と「Sheet3」が存在するか調べるプログラムに
書き換えました。

01：Option Explicit
02：Sub Main()
03：　　Dim f As String
04：　　Dim s As Shape
05：　　Dim n As Worksheet
06：　　Dim c As Boolean
07：　　Application.DisplayAlerts = False
08：　　f = Dir("D:\Test\" & "*.xls")
09：　　Do While f <> ""
10：　　　　Workbooks.Open "D:\Test\" & f
11：　　　　For Each n In Worksheets
12：　　　　　　If n.Name = "Sheet2" Then c = True
13：　　　　Next
14：　　　　If c = True Then
15：　　　　　　Worksheets("Sheet2").Delete
16：　　　　End If
17：　　　　For Each n In Worksheets
18：　　　　　　If n.Name = "Sheet3" Then c = True
19：　　　　Next
20：　　　　If c = True Then
21：　　　　　　Worksheets("Sheet3").Delete
22：　　　　End If
23：　　　　Set s = ActiveSheet.Shapes.AddPicture(Filename:="D:\Test\Cat.jpg", LinkToFile:=True, SaveWithDocument:=False, Left:=Selection.Left, Top:=Selection.Top, Width:=480, Height:=360)
24：　　　　ActiveSheet.Protect
25：　　　　Workbooks(f).Close SaveChanges:=True
26：　　　　f = Dir()
27：　　Loop
28：End Sub

これで、「Sheet2」や「Sheet3」がそれぞれ
存在したときだけ、削除しますので、
エラーは出ないはずですが、
もし、一度、私のプログラムを通しておられる場合、
今度は、プロテクトがすでにかかってしまっていますので、
プロテクトを解除しておく必要があります。

01：Option Explicit
02：Sub Unprotect()
03：　　Dim f As String
04：　　Dim s As Shape
05：　　Application.DisplayAlerts = False
06：　　f = Dir("D:\Test\" & "*.xls")
07：　　Do While f <> ""
08：　　　　Workbooks.Open "D:\Test\" & f
09：　　　　ActiveSheet.Unprotect
10：　　　　Workbooks(f).Close SaveChanges:=True
11：　　　　f = Dir()
12：　　Loop
13：End Sub

これが、解除するプログラムですので、
私のプログラムを実行してしまっている場合、
まず、このプログラムを通して、
プロテクトを解除してから、
上記のプログラムを通してください。

このプログラムは、説明しなくても
もう、分かって頂けますよね？

上記のプログラムの意味は、
11～13行目で、「Sheet2」を探し、
見つかった場合は、「c = True」。

もし、cの値が「True」だったら削除。

という行を「Sheet3」とあわせて
追加しました。

不明な点が、あれば、また、質問してください。

お礼

度々のご回答ありがとうございます。
おかげさまで、希望のとおりできました。
本当に感謝！感謝！です。

回答No.3

Prome_Lin

遅くなり、すみません。

少し調べてみましたが、私では、分かりませんでした。

そこで、提案ですが、ワードのテキストボックス内の図形を
画像として、ファイルに保存されてはどうでしょうか？

それなら、私の組んだプログラムで、対処できますが…

図形上で、マウスの右クリックから「図として保存」などの項目が
出て来ないでしょうか？

出て来たら、名前を付けて、分かりやすい場所に保存し、
そのファイルを取り込めばＯＫです。

ちゃんとした答えになっておらず、申し訳ございません。

お礼

度々のご回答ありがとうございます。
試してみましたが、「インデックスが有効範囲にありません」と表示されます。
なぜでしょうか？よろしくお願いします。

回答No.2

Prome_Lin

はい、「Dir("D:\Test\" & "*.xls")」は
「Ｄ」ドライブの「Test」というフォルダ内の
拡張子が「xls」というすべてのファイルという意味です。

それから、エクセルと同じフォルダ内にある
テキストボックス、とありますが、
テキストボックスが独立して存在するわけはないので
エクセルのファイルとして存在しているのですか？

ワードですか？

エクセルだと、同じフォルダにあると
ちょっとやっかいです。

すべてのエクセルのファイルを処理してしまうので、
その「テキストボックス」のあるファイルだけ
マクロ（プログラム）用にして、
いったん、別フォルダに置いても構わないでしょうか？

そうか、ファイル名を指定しておいて頂ければ
そのファイルをこのプログラムから無視させることも可能ですが、
それでも良いですか？

お礼

度々のコメントありがとうございます。
＞エクセルのファイルとして存在しているのですか？
＞ワードですか？
ワードです。
よろしくお願いします。

回答No.1

Prome_Lin

まず、「１」についてですが、コピーする図形の元は、どこにあるのですか？

今、図形ではなく、画像がファイルとして同じフォルダに存在している場合で
プログラムを組んでみました。

このプログラムでは、処理するエクセルのファイルが、
すべて同じフォルダに存在していなければなりません。

01：Option Explicit
02：Sub Main()
03：　　Dim f As String
04：　　Dim s As Shape
05：　　Application.DisplayAlerts = False
06：　　f = Dir("D:\Test\" & "*.xls")
07　　　Do While f <> ""
08：　　　　Workbooks.Open "D:\Test\" & f
09：　　　　Worksheets("Sheet2").Delete
10：　　　　Worksheets("Sheet3").Delete
11：　　　　Set s = ActiveSheet.Shapes.AddPicture(Filename:="D:\Test\Cat.jpg", LinkToFile:=True, SaveWithDocument:=False, Left:=Selection.Left, Top:=Selection.Top, Width:=480, Height:=360)
12：　　　　ActiveSheet.Protect
13：　　　　Workbooks(f).Close SaveChanges:=True
14：　　　　f = Dir()
15：　　Loop
16：End Sub

07行目の「Do While～」で、ファイルを順次処理しています。

処理するフォルダは、その上の06行目で指定しています。

画面上は、「\」で表示されていますが、
エクセル上では半角の「￥」マークです。

09行目と10行目で、開いたエクセルのファイルの
「Sheet2」と「Sheet3」という名前のシートを削除しています。

決して、２番目のシートと３番目のシートという意味ではありません。

シート名を直接指定しています。

11行目で、画像ファイルを左上端に挿入しています。

最後の数字（480、360）は、画像の大きさです。

12行目で、プロテクトをかけています。

13行目で、保存終了しています。

14行目は、ファイル名をクリアしておいて、
次のファイルを読み込むための準備です。

もし、何か、特定のエクセルのファイルから
画像ではなく、「図形」をコピーするのでしたら、
11行目が変わります。

そのときは、また、お知らせください。

なお、このプログラム自身は、
他のフォルダにある、エクセルのファイルです。

同じフォルダ内には、存在しません。

お礼

ご回答ありがとうございます。
＞まず、「１」についてですが、コピーする図形の元は、どこにあるのですか？
処理するエクセル・ファイルと同じフォルダにあります。また画像ではなく図形（テキストボックス）です。
＞("D:\Test\" & "*.xls")
これはDドライブのTestという名前のフォルダを意味するのですか？