制御 Excelappliを消す(アプリケーションを一時的に隠す)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'UserForm1

Private Sub UserForm_Initialize()
'開始処理

Excel.Application.Visible = False
'画面変更しない
Application.ScreenUpdating = False
'アプリのステータスを表示
Application.StatusBar = "○○○システム"
'アプリのキャピション変更
Application.Caption = "○○○システム"

'必要ファイルのオープン-------------------------------------------->>

Dim wbPersonal
Dim wbPersonal1
Dim BookPath As String
Dim PathBOK As String
Dim TrgtBOK As String
Dim TrgtBOK1 As String

PathBOK = ".xls"

TrgtBOK = ".xls"
TrgtBOK1 = ".xls"

    On Error Resume Next
    Set wbPersonal = Workbooks(TrgtBOK)
    Set wbPersonal1 = Workbooks(TrgtBOK1)
    On Error GoTo 0
    If IsObject(wbPersonal) Then
        MsgBox wbPersonal.Name & _
        "はすでに開いています。OKボタンを押してください。", vbCritical, "注意"
        Workbooks(TrgtBOK).Close SaveChanges:=False
    End If

    If IsObject(wbPersonal1) Then
        MsgBox wbPersonal1.Name & _
        "はすでに開いています。OKボタンを押してください。", vbCritical, "注意"
        Workbooks(TrgtBOK1).Close SaveChanges:=False
    End If

    Set wbPersonal = Nothing
    Set wbPersonal1 = Nothing

    'パス取得
    BookPath = Workbooks(PathBOK).Path

    '必要ファイルをオープン
    With Workbooks
        .Open Filename:=BookPath & "\" & TrgtBOK, ReadOnly:=False
    End With
    '必要ファイルをオープン
    With Workbooks
        .Open Filename:=BookPath & "\" & TrgtBOK1, ReadOnly:=False
    End With
End Sub


Private Sub UserForm_QueryClose(CANCEL As Integer, CloseMode As Integer)
'×ボタン制御
    If CloseMode = 0 Then
        MsgBox "{ CLOSE }ボタンで閉じて下さい", vbExclamation, "jp-ia"
        CANCEL = True
    End If
End Sub


Private Sub CommandButton8_Click()
'終了ボタン
    'メッセージ
    If MsgBox("システムを終了します。", vbOKCancel, "システム終了") = _
    vbCancel Then Exit Sub

    '画面更新しない
    Application.ScreenUpdating = False

    '各設定を元に戻す
    Workbooks("PDP.v2.00.xls").Activate
    Workbooks("PDP.v2.00.xls").Protect Windows:=False

    'メニューバーコントロールを戻す。
    Application.CommandBars("worksheet menu bar").Reset

    'スクリーンを戻す。
    Application.DisplayFullScreen = False

    '初期表示画面にセッティング
    Workbooks("PDP.v2.00.xls").Activate
    Sheets("OPEN").Select

    'メインメニュー閉じる
    Unload Me

    '現在開いているBOOKを全て保存しEXCELを閉じます。
    Dim w As Workbook
    For Each w In Application.Workbooks
    w.Save
    Next w

MsgBox "保存処理時間を10秒程度要します。", 0, "システム終了"

Dim thisTime As Single, stopTimer As Single

stopTimer = 10 ' 中断時間(秒)設定
thisTime = Timer ' 中断の開始時刻を設定
Do While Timer < thisTime + stopTimer
DoEvents ' 他のプロセスに制御
Loop

MsgBox "この後、全ての管理システムが終了します。" _
& vbCr & vbCr & "お疲れ様でした", 0, "システム終了"

Application.Quit

End Sub



 

2000年01月01日|[VBサンプルコード]:[制御]