VBAでシート名を変える、グラフのリンクを切る等を教えてください

質問

以前、「複数ブックのシートを一つのブックにコピーする」ＶＢＡを教えていただきました。

そこで、誠に恐縮なのですが、下記を追加するにはどのようにすればよいのでしょうか？
1、コピー元とのグラフのリンクを解除する。
　　　数式のリンクは解除されているので、恐らくグラフのリンクが解除されていない。毎回、編集→リンクの設定で解除している。
2、シート名をセルＢ２の５文字目以降にしたい。
3、1つのセルに255文字以上入力されている、以降の文字がコピーしない現象を回避。
　　　シートのコピーをすると、255文字以降がコピーされない？？
　　　セルを範囲選択してコピーした場合は、コピーできる。
4、最後に「Sheet1」を削除

下記が現在のＶＢＡです。
Sub Consolid03()
Dim mb As Workbook, wb As Workbook
Dim myfdr As String, fname As String, n As Integer
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全て検索
If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。
wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) '開いたシートをコピーしてmbの末尾に置く
wb.Close (False) '有無を言わずに保存せず閉じる
mb.Sheets(mb.Sheets.Count).Unprotect Password:="9" 'パスワード解除
For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に
If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば
c.Value = c.Value '値に変更
End If
Next
mb.Sheets(mb.Sheets.Count).Protect Password:="9" 'パスワード保護
n = n + 1 'ブック数をカウント
End If
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _
+ Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _
+ Chr(&HD) + Chr(&HA) + "" _
+ Chr(&HD) + Chr(&HA) + "取りこんだシートにパスワード保護もかけておきましたよ。", , "（￣ー￣）v "
End Sub

以上、ご教示願います。。。

回答No.3

xls88 · ベストアンサー

違うシートのセルB2ということはないですか？

ws.Name = Mid(ws.Range("B2").Value, 5)
上記で、コピー追加したシートのセルB2のデータを切り取ってシート名にしています。
それで合っているなら、セルB2に正しくデータが入力されているかどうか確認してください。

正しく入力されているようなら、1行上に
MsgBox Mid(ws.Range("B2").Value, 5)
を入れてマクロを実行してみてください。
どんな答えが返ってきますか？

お礼

xls88さん、何度もありがとうございます。
原因がわかりました。Ｂ２に制御文字「：」と「/」が入っていました。
できれば、「：」と「/」は、削除したくないのですが。。。
全部削除しないと無理なのでしょうか？

回答No.4

xls88

>原因がわかりました。Ｂ２に制御文字「：」と「/」が入っていました。
>できれば、「：」と「/」は、削除したくないのですが。。。
それは無理ということではないでしょうか。
何故、削除したくないのですか？
たとえ事情があるにしても、Excelさんが承知するはずがないです。
消去するなら
ws.Name = Replace(Replace(Mid(ws.Range("B15").Value, 5), ":", ""), "/", "")
置き換えるなら
ws.Name = Replace(Replace(Mid(ws.Range("B15").Value, 5), ":", "☆"), "/", "★")
としてください。

>グラフのリンクの件
>「自」ブックの中で、他シートを参照し、グラフを表示しています。
コピー先での「元のデータ」はどうなるのですか？
「元のデータ」が用意されていて、リンクを切れば「元のデータ」が切り替わるようになっているのですか？

回答No.2

xls88

dorikinさんオリジナルマクロに組み込んでみました。
追加したところは、★印でコメントしてあります。
動作は未確認です。

ひとつ気になるところがあります。
wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) '開いたシートをコピーしてmbの末尾に置く
開いたブックwbのActiveSheetをCopyしていますが
ActiveSheetが一定で決まっているなら問題ないです。
しかし、複数のシートが存在する場合、目的のシートがActiveSheetである保証はないと思います。
拙くはないですか？

Sub Consolid03_test()
　　Dim mb As Workbook, wb As Workbook
　　Dim myfdr As String, fname As String, n As Integer
　　Dim ws As Worksheet '★(1)追加シートの変数

　　Application.ScreenUpdating = False '画面更新を一時停止
　　Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
　　myfdr = ThisWorkbook.Path
　　fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
　　Do Until fname = Empty '全て検索
　　　　If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ
　　　　　　Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。
　　　　　　'★↓ここまずくないですか？
　　　　　　wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) '開いたシートをコピーしてmbの末尾に置く
　　　　　　wb.Close (False) '有無を言わずに保存せず閉じる

　　　　　　Set ws = mb.Sheets(mb.Sheets.Count) '★(2)追加したシート
　　　　　　ws.Name = Mid(ws.Range("B2").Value, 5) '★(3)追加したシートの名前変更
　　　　　　ws.Unprotect Password:="9" '★(4)パスワード解除
　　　　　　'mb.Sheets(mb.Sheets.Count).Unprotect Password:="9" 'パスワード解除

　　　　　　For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に
　　　　　　　　If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば
　　　　　　　　　　c.Value = c.Value '値に変更
　　　　　　　　End If
　　　　　　Next
　　　　　　ws.Protect Password:="9" '★(5)パスワード保護
　　　　　　'mb.Sheets(mb.Sheets.Count).Protect Password:="9" 'パスワード保護

　　　　　　n = n + 1 'ブック数をカウント
　　　　End If
　　　　fname = Dir 'フォルダ内の次のExcelブックを検索
　　Loop '繰り返す

　　mb.Sheets("Sheet1").Delete '★(6)最後にSheet1を削除

　　Application.ScreenUpdating = True '画面更新一時停止を解除
　　MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _
　　　　+ Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _
　　　　+ Chr(&HD) + Chr(&HA) + "" _
　　　　+ Chr(&HD) + Chr(&HA) + "取りこんだシートにパスワード保護もかけておきましたよ。", , "（￣ー￣）v "
End Sub

お礼

xls88さん、ご回答ありがとうございます。
上記をコピーして実行してみたのですが、「実行時エラー1004　シートまたはグラフの名前が正しくありません」とエラーになります。
デバックをみると、
「ws.Name = Mid(ws.Range("B2").Value, 5) '★(3)追加したシートの名前変更」
の部分が黄色くなっています。
この1行を削除すると実行できるのですが、シート名をセルＢ２の５文字目以降にはなっていません。。。（Sheet1は削除になっていました）

「★↓ここまずくないですか？」の部分の件
シートは複数あります。開いた時に目的のシートが表示されるよう保存をしてから、マクロ実行しています。目的のシートはマクロ実行のたびに変わるのですが、シート名は全てのブックで共通です。シート名を指定してからマクロをかけられれば、それが一番よいのですが。。。

グラフのリンクの件
「自」ブックの中で、他シートを参照し、グラフを表示しています。
マクロの実行をするのと、「他」のブックとのリンクになってしまいます。
このリンクを解除するのは難しいのでしょうか？

回答No.1

xls88

>1、コピー元とのグラフのリンクを解除する。
>数式のリンクは解除されているので、恐らくグラフのリンクが解除されていない。
>毎回、編集→リンクの設定で解除している。

グラフの場所はどこになっていますか？
(1)データとグラフが同じシートにあるなら
シートそのものをコピーしているので、グラフと元のブックとの関係は遮断されているはずです。
(2)データとグラフが異なるシートにあるなら
データシートとグラフシートを、同時に同じブックにコピーすればグラフと元のブックとの関係は遮断されます。
(3)データとグラフが異なるシートにあり、グラフシートのみコピーした場合
グラフの各系列毎に、SERIES関数を値に置き換えればよいと思います。

>2、シート名をセルＢ２の５文字目以降にしたい。
Activesheet.Name = Mid(Worksheets("Sheet1").Range("B15").Value, 5)

>3、1つのセルに255文字以上入力されている、以降の文字がコピーしない現象を回避。
パスします。

>4、最後に「Sheet1」を削除
Workbooks("Knet1グラフ5.xlsm").Sheets("Sheet1").Delete

お礼

ありがとうございます。
ご回答をいただいてから上記をコピーして実行してみたのですが、エラーになります。
このマクロは1つのフォルダの中に複数のブックを入れ（マクロ入りブックも含む）、マクロ入りブックのみ開き、マクロ実行すろと全てのブックのシートがマクロ入りブックのシートに追加されるマクロです。

具体的には、どの行に（そのまま？）コピーすればよいのでしょうか？
マクロ初心者で申し訳ありません。。。
よろしければ、ご教示願います。

補足

制御文字を取り除くことに成功しました。
ありがとうございました。