|
こういうことですか?
Sub test()
Dim sFullPath As String
Dim iWbCnt As Long
Dim wb As Workbook
Dim wbDel As Workbook
iWbCnt = 0
For Each wb In Workbooks ' 開いてる全てのワークブックについて処理する
Select Case wb.Name ' ワークブックの名前で分岐
Case "PERSONAL.XLSB" ' 個人用マクロブックの場合は処理無し
Case "PERSONAL.XLS" ' 個人用マクロブックの場合は処理無し(Excel2007以上)
Case ThisWorkbook.Name ' 本ファイルと同じ名前の場合
iWbCnt = iWbCnt + 1
Case Else
iWbCnt = iWbCnt + 1
sFullPath = wb.Path & "\" & wb.Name ' 削除するためにフルパス保持
Set wbDel = wb
End Select
Next
If iWbCnt <> 2 Then
MsgBox "ファイルを二つだけ開いた状態で実行してください。"
Exit Sub
End If
'#######################################
Range("D9:G10").Select
With Selection.Font
.Name = "MS P明朝"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D9:G10").Select
'#######################################
wbDel.Close False ' ファイルを閉じる
Kill sFullPath ' ファイルを削除する
End Sub
|
|