フォルダ内にある複数ブックのシート名の変更

質問

エクセルのＶＢＡについて質問させて下さい。
現在、アクセス２０００でクエリをマクロのワークシート変換で
規定のエクセルブック（２０００）にエクスポートしています。
項目別なので３０以上のブックになっています。
これを毎月の更新で１２ヶ月分エクスポートします。
問題なのがクエリ名がシート名になっていますが、このシート名を
月によって変更したいのです。ブックが３０以上あるので手作業では
自分１人の作業だとやってしまうのですが、不在時に他の人にやって
もらうには無理があるかなと・・・。
イメージとしては、マクロブックのコマンドボタンを押すと
そのフォルダにある３０以上のブックの一番右にあるシートを
マクロブックのセルＡ１に入力した月に変更し、変更したシート内の
１行目の項目名の長さに合わせてセルの幅を変更し、項目名に色をつけるというイメージです。
今までは２項目くらいだったので手作業でやっていたのですが、
３０以上になると手作業ではつらい状況です。
ＶＢＡは初心者なので答えをいただけると大変ありがたいです。

よろしくお願いします。

回答No.4

mt2008 · ベストアンサー

その列の最大のセルの幅に合わせて良いのでしたら例1を、そうではなく、項目(1行目）の内容で調整した幅に合わせるのでしたら、例2を
ws.Name = ws.Range("T2") & "月"
の下に入れます。

なお、どちらを使用する場合も
Dim nCount As Long
Dim sVal As String
を先頭の方に入れてください。
また、例2を使用する場合は、項目のフォント種やフォントサイズが不明な場合調整が難しい為、作業用シートに項目をコピーしてExcelに幅を調整させ、その幅を対象列に反映しています。
マクロがあるブックのSheet3を作業用シートとして使用しますのでSheet3は空にして置いてください。

【例1】
'対象シートのA1から右に順番に処理、空白セルがあったら処理終了
nCount = 1
sVal = ws.Cells(1, nCount).Value
Do While sVal <> ""
　'幅を調整
　ws.Columns(nCount).EntireColumn.AutoFit
　'項目セルに色付け
　ws.Cells(1, nCount).Interior.ColorIndex = 38　'色は適当

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

【例2】
'対象シートのA1から右に順番に処理、空白セルがあったら処理終了
nCount = 1
sVal = ws.Cells(1, nCount).Value
Do While sVal <> ""
　'対象項目セルをコピー
　ws.Activate
　ws.Cells(1, nCount).Select
　Selection.Interior.ColorIndex = 38 '色は適当
　Selection.Copy
　'作業用シートのA1にコピー
　ThisWorkbook.Activate
　Sheets("Sheet3").Select　'Sheet3を作業用シートとして使用
　Range("A1").Select
　ActiveSheet.Paste
　'-----AutoFitで幅調整
　Columns("A:A").EntireColumn.AutoFit
　nColWidth = Range("A1").ColumnWidth

　対象列にその幅を反映
　ws.Columns(nCount).ColumnWidth = nColWidth

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

それと、今のマクロのままですと、「一番右にあるシート」だけでなく、全てのシートが変更対象になりますので、2箇所修正します。
For Each ws In wb.Worksheets
↓
Set ws = wb.Worksheets(wb.Sheets.Count)

Next
↓
'Next

最初の質問内容からだけでは「答え」は難しいですよ。決して揚げ足取りのつもりでは有りません。

お礼

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

勉強不足で話しについていけないことが多かったですが
大変助かりました。

補足

>最初の質問内容からだけでは「答え」は難しいですよ。決して揚げ足
>取りのつもりでは有りません。

こちらも詰まっていたのですいません。
ただ、こういうことをしたいのですか？と事例を挙げてくれれば
対応も違うと思います。

おかげさまでなんとかできたい処理ができました。
ありがとうございます。

また問題が出て今度は定義の削除で悩んでいます。

どうしたらいいのやら・・。

回答No.3

n-jun

ANo.2です。

初めに提示された質問と補足で提示されたコードは、内容に食い違いがありますが、そこはスル～でいいのでしょうか？

実際動いているのであればいいですけど、
＞If Trim(ws.Range("T2") & "月") <> "" Then
って違うように思いました。
仮にセルT2が空白であったなら"月"と""を比較するわけですから、当然違いますよね。

あとセルの幅を自動に合わせるのであれば、例えばＡ列からＤ列なら
Range("A:D").EntireColumn.AutoFit
ですが、ここでシートの指定が必要なので
ws.Range("A:D").EntireColumn.AutoFit
となるのかな。

色のつけ方についても
With ws
.Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Interior.ColorIndex = 8
End With
とか。

色については
http://www.relief.jp/itnote/archives/000482.php
をご参考に。

それぞれFor Each ws～　の直下でもいいかと思いますけど。

補足

>初めに提示された質問と補足で提示されたコードは、内容に食い違い
>がありますが、そこはスル～でいいのでしょうか？

わからなかったので検索して見つけたコードに合わせて
クエリに月という項目を加えてそれを条件にしただけです。
月のＴ１が空白ならシート名の変更を行わずにスルーという形に
なってしまいますが、データがない場合はしょうがないかなと・・。

また問題が出て、ブックのシートにワークシート変換した際に
定義がつけられてしまって月の指定を変えてエクスポートしても
定義がつけられた前月のワークシートにデータを貼り付けようと
してエラーが出てしまって・・・。

どうしたらいいのやら・・。
定義の削除ってＶＢＡでできるんでしょうか？

難しいコードで言われてもわからないんですけど・・。

回答No.2

n-jun

”答え”って言っても提示された状況からでは”推測による回答”しかでませんが、
あとはご自身で修正できるのでしょうか？って疑問がでましたけど。

補足

以下のコードでシート名の変更はできましたが
変更したシート内の１行目の項目名の長さに合わせてセルの幅を
変更し、項目名に色をつけるという作業がわからないです。

Dim path$, wb As Workbook, wbName$
Dim ws As Worksheet, i&
path = ThisWorkbook.path & "\"
wbName = Dir(path & "*.xls")
Do Until wbName = ""
If wbName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(path & wbName)
i = 2
For Each ws In wb.Worksheets
If Trim(ws.Range("T2") & "月") <> "" Then
On Error Resume Next
ws.Name = ws.Range("T2") & "月"
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

回答No.1

mt2008

大変お困りなのは判りますが、まずはご自分の質問を読み返してみてください。
あなたは困っている事とやりたい事を述べているだけで質問をしていません。

まずはマクロの記録で操作を記録し、そのコードを修正する中で不明な点を質問してください。

補足

それがわからないから質問してるんですけど・・。