プロが教えるわが家の防犯対策術!

前からあったエクセルのファイルのどこかが壊れたらしく、ときどき作業中に突然エラーとなってエクセル自体が落ちてしまうので、BOOKの複製では意味がないと考え、同じ内容のものを別BOOKに再作成するマクロを以下のとおり作ってみました。(新規作成のBOOKにこのマクロを貼ります)
これで、VBAのモジュールを除き、再作成できたのですが、どういうわけか「名前の定義」を行なったセル範囲の一部が反映されません。
調べてみると、他のセルから参照されていない「名前の定義」がすっぽり抜け落ちるようにも思えるのですが、この理解であっているでしょうか?
他のセルから参照していなくとも、マクロで参照しているので抜け落ちるのは困ります。
どうすれば、すべての「名前の定義」が再作成されるでしょうか?

Sub Book_Copy()

Dim fn As String
Dim wb1 As Workbook, wb2 As Workbook
Dim ans As Integer, i As Integer
Dim nm As Name
Dim sh As Worksheet

fn = Application.GetOpenFilename("エクセル ファイル (*.xls), *.xls")
If fn = "False" Then Exit Sub

Application.EnableEvents = False
Set wb1 = Workbooks.Open(Filename:=fn, UpdateLinks:=1)
Set wb2 = ThisWorkbook

ans = MsgBox(wb1.Name & "を " & wb2.Name & " へCopyしますか?", vbYesNo + vbQuestion)
If ans = vbNo Then Exit Sub

For Each nm In wb2.Names
nm.Delete
Next nm

For Each sh In wb1.Worksheets
sh.Cells.Copy
i = i + 1
If wb2.Worksheets.Count = i Then
wb2.Worksheets.Add After:=Worksheets(i)
Application.DisplayAlerts = False
wb2.Activate
wb2.Worksheets(i).Activate
wb2.Worksheets(i).Cells.Select
ActiveSheet.Paste
wb2.Worksheets(i).Name = sh.Name
Application.DisplayAlerts = True
Application.CutCopyMode = False
End If
Next sh

wb1.Close (False)
Application.EnableEvents = True
ActiveWorkbook.ChangeLink Name:=fn, NewName:=wb2.Name, Type:=xlExcelLinks
Set wb1 = Nothing
Set wb2 = Nothing

End Sub

A 回答 (2件)

こんばんは。



コードをみる限りは、「名前の定義」が写されているようには思えないのですが……。

それは、ともかく、別の掲示で、最近、VBA自身の取り扱いとしては「名前の定義」に難色を示したのですが、「名前の定義」の設定は、文字列の数式なのですね。つまり、VBAとしては、数式と同じなのだと思います。ただ、そう、安易に考えないほうがよいかもしれません。理由は、Names の親オブジェクトの問題です。


細かいところは、良く検討されていませんが、こちらで、少し、書き直してみました。

Sub Book_Copy2()
  Dim fn As String
  Dim wb1 As Workbook, wb2 As Workbook
  Dim ans As Integer, i As Integer
  Dim n As Integer, m As Integer
  Dim nm As Name
  
  fn = Application.GetOpenFilename("エクセル ファイル (*.xls), *.xls")
  If fn = "False" Then Exit Sub
  
  Application.EnableEvents = False
  
  Set wb1 = Workbooks.Open(Filename:=fn, UpdateLinks:=1)
  Set wb2 = ThisWorkbook
  
  ans = MsgBox(wb1.Name & "を " & wb2.Name & " へCopyしますか?", vbYesNo + vbQuestion)
  If ans = vbNo Then Exit Sub
  
  For Each nm In wb2.Names
    nm.Delete
  Next nm
  
  n = wb1.Worksheets.Count
  m = wb2.Worksheets.Count
  If n > m Then
    wb2.Worksheets.Add After:=wb2.Worksheets(m), Count:=n - m
  End If
  
  For i = 1 To m
    wb1.Worksheets(i).Cells.Copy wb2.Worksheets(i).Range("A1")
    wb2.Worksheets(i).Name = wb1.Worksheets(i).Name
  Next i
  '名前定義の移し変え
  For Each nm In wb1.Names
    With nm
      wb2.Names.Add .Name, .RefersTo, True
    End With
  Next nm
  wb1.Close False
  Application.EnableEvents = True
  On Error Resume Next
  ActiveWorkbook.ChangeLink Name:=fn, NewName:=wb2.Name, Type:=xlExcelLinks
  On Error GoTo 0
  Set wb1 = Nothing
  Set wb2 = Nothing
End Sub
    • good
    • 0
この回答へのお礼

Wendy02さま、大変ありがとうございます。
おかげさまで目的を達することができます。

> コードをみる限りは、「名前の定義」が写されているようには思えないのですが……。

ActiveWorkbook.ChangeLink Name:=fn, NewName:=wb2.Name, Type:=xlExcelLinks
で定義も写されますよ。ただし、参照されているのだけでしたが。

> '名前定義の移し変え
> For Each nm In wb1.Names
> With nm
> wb2.Names.Add .Name, .RefersTo, True
> End With
> Next nm

なるほど、全部やるにはこうやるんでね。勉強になります。
最後にもう一ついいですか?

.RefersTo, True は nm の範囲をそのままという理解でいいですか?
(通常は RefersToR1C1:="=SheetC!R2C3:R6C5"とか範囲を指定しなければいけないので)

お礼日時:2008/03/14 09:58

こんにちは。



>.RefersTo, True は nm の範囲をそのままという理解でいいですか?
>(通常は RefersToR1C1:="=SheetC!R2C3:R6C5"とか範囲を指定しなければいけな
いので)

細かいことは調べていませんが、数式と同じ考え方ではないでしょうか?
本来、Ver.4以前のオブジェクトでない限りは、内部的には、原形のようなものがって、それを、そのまま移すと考えました。プロパティに選択肢を持っているものは、明示的に、R1C1 スタイルにする必要はないと思います。
    • good
    • 0
この回答へのお礼

ありがとうございます。
助かりました。

お礼日時:2008/03/14 12:09

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!