| |
どうしても、分からないので教えて下さい
今、デスクトップ上のフォルダ内の複数のBOOKを一つのBOOKにまとめる…
といったマクロを作成しています。
その中で、同じシート名が、新Book先にあれば、差し替えるか？差し替えないか？
の確認をして、処理を行っています
しかし、なぜか、存在しないシート名でも、TRUEとなってしまいます
ｺｰﾄﾞの書き方がよくないのでしょうか？
アドバイスのほうよろしくお願いします
Sub FILE結合()
Dim DesktopPath As String
Dim Shellobject As IWshRuntimeLibrary.WshShell
Dim myFSO As New FileSystemObject
Dim myFolder As Folder
Dim myFiles As Files
Dim myFile As File
Dim q As Integer
Dim WSName As String
Dim MyFileName As String
Dim WS As Worksheet, flag As Boolean
Dim Ans As Integer
Set Shellobject = New IWshRuntimeLibrary.WshShell
DesktopPath = Shellobject.SpecialFolders("Desktop")
Set myFolder = myFSO.GetFolder(DesktopPath & "\ファイル")
Set myFiles = myFolder.Files
For Each myFile In myFiles
Workbooks.Open myFile
For q = 1 To Worksheets.Count
Worksheets(q).Activate
WSName = Worksheets(q).Name
MyFileName = Left(myFile.Name, (InStr((myFile.Name), ".") - 1))
ThisWorkbook.Activate
For Each WS In Worksheets
If WS.Name = WSName Then flag = True
Next WS
If flag = True Then ’←同じシートが存在しないのに、TRUEになってしまう
Ans = MsgBox("同じシート名があります、差し替えますか？", vbInformation + vbYesNo, "シート確認")
Select Case Ans
Case vbYes
Application.DisplayAlerts = False
Worksheets(WSName).Delete
Application.DisplayAlerts = True
Workbooks(MyFileName).Activate
Cells.Select
Range("B1").Activate
Selection.Copy
ThisWorkbook.Activate
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Select
Cells.Select
ActiveSheet.Paste
Range("D8").Select
Worksheets(Worksheets.Count).Name = WSName
Case vbNo
'なにもしない
End Select
Else
Workbooks(MyFileName).Activate
Cells.Select
Range("B1").Activate
Selection.Copy
ThisWorkbook.Activate
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Select
Cells.Select
ActiveSheet.Paste
Range("D8").Select
Worksheets(Worksheets.Count).Name = WSName
End If
Workbooks(MyFileName).Activate
Next q
Workbooks(MyFileName).Close False
Next
MsgBox "フォルダ内のファイルを一つのブックにまとめました"
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
