| |
▼INA さん：
>>Private Sub Workbook_BeforeClose(Cancel As Boolean)
>は、どんなコードでしょうか？
>
>Application.DisplayAlerts =false では消えませんか？
下記のコードなんですが、displayalertsでは消えなかったです・・・・
下手すぎて恥ずかしいですTT
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim myFileName As String
Dim MyPath As String
Dim i As String
Dim MyName As String
On Error Resume Next
If InStr(1, i, "-") = 0 Then
i = ThisWorkbook.Name
i = Left(i, InStr(i, "-") - 1)
If Err.Number Then
MsgBox "フォームは変えないようにしてください。"
Exit Sub
End If
On Error GoTo 0
Else
MsgBox "このファイルは保存できません｡"
Exit Sub
End If
MyPath = '場所を設定しています
MyName = Dir(MyPath, vbDirectory)
Do While MyName <> "" ' ループを開始します。
If MyName <> "." And MyName <> ".." Then
' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
If MyName = i Then
i = MyName
Exit Do
End If
End If
End If
MyName = Dir
Loop
On Error Resume Next
ChDrive MyPath & i
ChDir MyPath & i & "\EXCELフォルダ"
If Err.Number Then
MsgBox "保存先フォルダが見つかりません。"
Exit Sub
End If
On Error GoTo 0
myFileName = Application.GetSaveAsFilename _
(ActiveWorkbook.Name, "Excelファイル(*.xls),*.xls")
If myFileName = "False" Then
Exit Sub
Else
On Error Resume Next
With Application
ActiveWorkbook.SaveAs myFileName
End With
If Err.Number Then
Exit Sub
End If
End If
On Error GoTo 0
Application.Quit
End Sub
|
|
