Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3288 / 13646 ツリー ←次へ | 前へ→

【63101】マクロ有効ブックで保存するにはどうしたらいいですか? yuki 09/10/8(木) 13:31 質問[未読]
【63102】Re:マクロ有効ブックで保存するにはどうし... Yuki 09/10/8(木) 15:42 発言[未読]
【63103】Re:マクロ有効ブックで保存するにはどうし... yuki 09/10/8(木) 18:44 お礼[未読]

【63101】マクロ有効ブックで保存するにはどうした...
質問  yuki  - 09/10/8(木) 13:31 -

引用なし
パスワード
   下記マクロをxlsm形式(マクロ有効ブック)で新規保存できるようにしたいのですが、
どこをどのように変更したらよいのでしょうか?
いろいろと書き換えてみましたがうまくいかずデバックの嵐です(/_;)
めちゃめちゃ初心者ですがよろしくお願いします。

Sub 上書きマクロ()

Dim dataFolder As String
Dim tmpSheet As Worksheet
Dim subFolder As String
Dim lastRow As Long
Dim fileName As String
Dim r As Long
Dim i As Long
Dim isOpen As Boolean
Dim book As Workbook
Dim csv As Workbook
Application.ScreenUpdating = False
dataFolder = "D:\makomako"
Set tmpSheet = Sheets("Sheet1")
tmpSheet.Cells.Clear
'フォルダ名取得
r = 1
subFolder = Dir(dataFolder & "\", vbDirectory)
Do While subFolder <> ""
If (GetAttr(dataFolder & "\" & subFolder) And vbDirectory) = vbDirectory Then
If subFolder <> "." And subFolder <> ".." Then
tmpSheet.Range("A" & r) = subFolder
r = r + 1 '出力行+1
End If
End If
subFolder = Dir
Loop
'csvファイル名取得
lastRow = tmpSheet.Range("A" & Rows.Count).End(xlUp).Row
r = 1
For i = 1 To lastRow
fileName = Dir(dataFolder & "\" & tmpSheet.Range("A" & i).Value & "\*.csv")
Do While fileName <> ""
tmpSheet.Range("B" & r) = Left(fileName, InStrRev(fileName, ".") - 1)
tmpSheet.Range("C" & r) = tmpSheet.Range("A" & i).Value
r = r + 1
fileName = Dir
Loop
Next
'ファイル名、フォルダ名で並べ替え
tmpSheet.Columns("B:C").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=tmpSheet.Range("C1"), Order2:=xlAscending, Header:=xlNo
'bookへcsvファイルを集計
lastRow = tmpSheet.Range("B" & Rows.Count).End(xlUp).Row
isOpen = False
For r = 1 To lastRow
fileName = dataFolder & "\" & tmpSheet.Range("C" & r).Value & "\" & tmpSheet.Range("B" & r).Value & ".csv"
Set csv = Workbooks.Open(fileName)
If Not isOpen Then
csv.Sheets(1).Copy
Set book = ActiveWorkbook
isOpen = True
Else
csv.Sheets(1).Copy After:=book.Sheets(book.Sheets.Count)
End If
book.Sheets(book.Sheets.Count).Name = tmpSheet.Range("C" & r).Value
csv.Close False
If tmpSheet.Range("B" & r).Value <> tmpSheet.Range("B" & r + 1).Value Then
book.SaveAs dataFolder & "\" & tmpSheet.Range("B" & r).Value
book.Close False
isOpen = False
End If
Next
Application.ScreenUpdating = True
End Sub

【63102】Re:マクロ有効ブックで保存するにはどう...
発言  Yuki  - 09/10/8(木) 15:42 -

引用なし
パスワード
   ▼yuki さん:
>下記マクロをxlsm形式(マクロ有効ブック)で新規保存できるようにしたいのですが、
>どこをどのように変更したらよいのでしょうか?

こんにちは。
私もYukiです。

>book.SaveAs dataFolder & "\" & tmpSheet.Range("B" & r).Value
book.SaveAs dataFolder & "\" & tmpSheet.Range("B" & r).Value & ".xlsm", _
      FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
にすれば良いみたいですよ。

【63103】Re:マクロ有効ブックで保存するにはどう...
お礼  yuki  - 09/10/8(木) 18:44 -

引用なし
パスワード
   ありがとうございます。
見事動きました。
多々感謝

3288 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free