dポイントプレゼントキャンペーン実施中!

こんにちは。
先日、同一フォルダの複数ブックのワークシート名の変更とセルの幅の変更とセルへの色付けを教えていただきました。

そこから先に問題が発生して、毎月更新するファイルなので
アクセスのクエリをエクスポートしていますが、エクスポート先の
ブックに名前の定義が残っているため、ワークシート名を変更しても
前月のシートにデータを上書きしてしまいます。
なのでシートの名前の定義の削除を行いたいのですが、
Dim nm As Name
 For Each nm In Application.Names
  nm.Delete
 Next
のコードを以前の質問から検索して使用してみましたが
nm.Delete
のところで名前が正しくありませんと出てしまいます。
アクセスでエクスポートしてエクセルに張り付いた名前の定義は
VBAでは削除できないのでしょうか?

最終的には同一フォルダの複数ブックのワークシートの
名前の定義をVBAで一括削除したいんですが・・・。

試してみたコードは下です。
結果はシート名(2)にシート名が変更されて
名前の定義は削除されていませんでした。
シート名を変更しているのでシート名と名前の定義の名称は
違っています。
Dim N As Object にしても結果は同様でした。
マクロの記録ではWorkbook.Names("AAA").Delete
になっていて定義の名前を指定しないとダメなのかなとか
思っていたりします・・。
度々で申し訳ないですが、お知恵を頂戴できないでしょうか?

Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
Dim nCount As Long
Dim sVal As String
Dim n As Name

path = ThisWorkbook.path & "\"

wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
Set ws = wb.Worksheets(wb.Sheets.Count)

If Trim(ws.Range("T2") & "月") <> "" Then
On Error Resume Next
ws.Name = ws.Range("T2") & "月"
nCount = 1
sVal = ws.Cells(1, nCount).Value
Do While sVal <> ""

 ws.Columns(nCount).EntireColumn.AutoFit

 ws.Cells(1, nCount).Interior.ColorIndex = 15


 nCount = nCount + 1
 sVal = ws.Cells(1, nCount).Value

for each n in wb.names
  n.delete
 next
 
 for each n in ws.names
  n.delete
 next



Loop

If Err.Number <> 0 Then
ws.Name = ws.Range("T2") & "月" & " (" & i & ")"

i = i + 1
End If
On Error GoTo 0
End If
DoEvents
'Next
wb.Save
wb.Close
End If
wbName = Dir
Loop
Set wb = Nothing
Set ws = Nothing

A 回答 (4件)

こんばんは。



>For Each n In wb.Names
>n.Delete
>Next

難しいですが、たぶん、VBAでは解決できないかもしれません。
結論から言うと、VBAで削除できない、「名前」があるということです。

>ワークシートが1つだからかなと手動で名前の定義を消して
>次の月をエクスポートして再度実行してみましたが
>ワークシート名は変わりますが、名前の定義が残ったままでした。

ダメ元ですが、一度、Names オブジェクトの親オブジェクトを変えて試してみてください。
Names オブジェクトの親オブジェクトは、Application, Book, Worksheet の三つあります。

Set a = Application.Names
Set b = ActiveWorkbook.Names
Set c = ActiveSheet.Names

また、同じようなエラーの質問があります。今回は、違うかもしれませんが、Nameオブジェクトが、VBAで削除できなくなってしまう現象があります。

http://oshiete1.goo.ne.jp/kotaeru.php3?qid=2616426
名前を一括削除するマクロ

「実行時エラー"1004":その名前は正しくありません」

なお、
Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&

ある程度、腕に自信のあるVBAプログラマでしたら、path$ のよう書き方は、古い書き方です。また、VBAには、ほとんど予約語がありませんが、 myPath As String という書き方のほうがよいです。i As Longです。

この回答への補足

おはようございます。

その質問のトピックは私も見ました。
やはり削除は無理なんでしょうか・・。

n.Delete
の部分を名前の定義の名前変更とかするにはどうしたら
いいのでしょうか?
削除できないなら定義の名前をエクスポートの際に
かぶらない名前に変えればできるかなとか思っています・・。

ご教授できないでしょうか?

補足日時:2008/10/20 10:21
    • good
    • 0

こんばんは。



>やはり削除は無理なんでしょうか・・。
それは、バグというか、私の考えでは、ワークシート側とVBA側は、完全な一致をしていないからなのだと思います。

ですから、

>n.Delete
>の部分を名前の定義の名前変更とかするにはどうしたら
>いいのでしょうか?

オブジェクトを取れれば、削除も出来れば、名前も変えることが出来ます。

名前登録が、'abc' を、'abb' に返るなら、
 Application.Names("abc").Name = "abb"

こんな風になるのですが、ただ、Namesオブジェクトを取得できればという条件付きです。
Names オブジェクトは使わないようにする、というのが、私が、いつもここで書いている話なのです。(そういうことを嫌がる人もいますが。)

>削除できないなら定義の名前をエクスポートの際に
>かぶらない名前に変えればできるかなとか思っています・・。

For Each n In wb.Names
    n.Delete
Next

For Each n In ws.Names
    n.Delete
Next

これで消えないとすれば、私の考えでは、そのプロセス自体が違うように思います。
何もない新規ブックに、Cells.Copy wb.ActiveSheet.Range("A1") のように表面だけ貼り付けたほうが良いようです。
    • good
    • 0
この回答へのお礼

こんにちは。
色々ありがとうございます。

色々検証してみて、できました。
クエリ名を数字&文字列から文字列&数字に
逆にしてみたら、名前の定義の削除ができました。
元のコードで大丈夫になりました。

どうしてそうなるのかはわからずじまいですが・・・。

お手数をおかけしました。m(__)m

お礼日時:2008/10/21 12:23

下記で1つのブックの名前の名前を表示できるようです。


Sub test03()
Dim sh As Worksheet
Dim nm
MsgBox Application.Names.Count
MsgBox ActiveWorkbook.Names.Count
For Each nm In ActiveWorkbook.Names
MsgBox nm.Name
Next
End Sub
MsgBox nm.Name

nm.Delete
に変えると出来ると思う。
Sub test03()
Dim sh As Worksheet
Dim nm
MsgBox Application.Names.Count
MsgBox ActiveWorkbook.Names.Count
For Each nm In ActiveWorkbook.Names
MsgBox nm.Name
Next
For Each nm In ActiveWorkbook.Names
nm.Delete
Next
End Sub
確認後は前半は削除のこと。
ーー
フォルダ内のすべてのブックの場合さらにActiveWorkbookのところをFor eachdで捉えればすべてを削除できるでしょう。

この回答への補足

おはようございます。
下のコードでやってみました。
定義の数も名前も一致しましたが
削除のnm.deleteのところでエラーになります。
nmでデバックになるようです。
For eachdはFor Eachd nm In ActiveWorkbook.Names
にするということなのでしょうか?
するとコンパイルエラーが出ます・・。
やはり、できないんでしょうか?
難しいですね・・・。




>Sub test03()
>Dim sh As Worksheet
>Dim nm
>MsgBox Application.Names.Count
>MsgBox ActiveWorkbook.Names.Count
>For Each nm In ActiveWorkbook.Names
>MsgBox nm.Name
>Next
>For Each nm In ActiveWorkbook.Names
>nm.Delete
>Next
End Sub

補足日時:2008/10/20 10:09
    • good
    • 0

どらか1つのファイルを開いて、



Sub TEST()
 Dim myName As Name
 For Each myName In ActiveWorkbook.Names
  myName.Delete
 Next
End Sub

のマクロを実行した場合に、名前は削除されますか?

この回答への補足

できません。
その名前は正しくありませんと出ます。

しかし、挿入→定義の中を見ると名前の定義があります。

ワークシートが1つだからかなと手動で名前の定義を消して
次の月をエクスポートして再度実行してみましたが
ワークシート名は変わりますが、名前の定義が残ったままでした。

どうにかなりますか?
下のコードにして見ましたがダメでした。

Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
Dim nCount As Long
Dim sVal As String
Dim n As Name

path = ThisWorkbook.path & "\"

wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
Set ws = wb.Worksheets(wb.Sheets.Count)


On Error Resume Next
ws.Name = ws.Range("T2") & "月"
nCount = 1
With ws.Rows(1)
With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft))
.Interior.ColorIndex = 15
.EntireColumn.AutoFit
End With
End With

For Each n In wb.Names
n.Delete
Next
wb.Save
wb.Close
End If
wbName = Dir
Loop
Set wb = Nothing
Set ws = Nothing

End Sub

補足日時:2008/10/17 17:19
    • good
    • 0

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