|
|
| |
| 本章では、プログラムの開始時や終了時に必要なコードサンプルを説明します。 |
| |
|
|
|
Sub プロシージャで、標準モジュールです。過去の Excel で使われていたもので、互換性維持のために残されています。 いずれもファイルが開いたとき／閉じる前に実行されるプロシージャです。 |
|
|
|
|
|
Application.Visible = False 'ウインドウを消す
Application.Visible = True 'ウインドウを復活 |
|
|
|
|
|
|
UserForm1.show '表示
Label1.Caption = "終了しました。" 'ユーザーフォームのキャプションに文言を設定
UnLoad UserForm1 '非表示 |
|
|
|
|
|
|
Option Explicit
Option Private Module
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function WindowFromObject Lib "oleacc" Alias "WindowFromAccessibleObject" _
(ByVal pacc As Object, phwnd As Long) As Long
Const WS_MAXIMIZEBOX = &H10000
Const WS_MINIMIZEBOX = &H20000
Const WS_THICKFRAME = &H40000 'サイズ変更
Const GWL_STYLE = (-16)
'ユーザーフォームに最大化・最小化ボタンを付け、又サイズ変更可能にする
Sub UformMaxMin(uf As UserForm)
Dim hwnd&
'hwnd = FindWindow(IIf(Application.Version < 9, "ThunderXFrame",
"ThunderDFrame"), uf.Caption)
WindowFromObject uf, hwnd 'Windows2000以降
SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or WS_MAXIMIZEBOX Or
WS_MINIMIZEBOX Or WS_THICKFRAME
DrawMenuBar hwnd
End Sub |
|
|
|
|
|
|
|
Application.ScreenUpdating = False 'ON
Application.ScreenUpdating = True 'OFF |
|
|
|
|
|
|
|
Application.DisplayAlerts = False |
|
|
|
|
|
|
Dim Bookname As String
Bookname = ActiveWorkbook.Name
|
|
|
|
|
|
|
Application.Cursor = xlWait
戻す
Application.Cursor = xlNormal
|
|
|
|
|
|
|
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds
As Long)
' EscキーでErrorHandlerへ進む
Application.EnableCancelKey = xlErrorHandler
On Error GoTo ESC_CHATCH
'Do
・・・・
'実行中のマクロを１秒間停止します。
DoEvents
Sleep 1000 ' msec
'Loop
ESC_CHATCH:
If MsgBox("ESCキーが押されました。終了しますか？", vbInformation + vbYesNo) =
vbYes Then
GoTo LOOP_EXIT
Else
Resume
End If
LOOP_EXIT:
' Escキー処理を戻す
Application.EnableCancelKey = xlInterrupt
Application.StatusBar = False
On Error GoTo 0 'エラー処理ルーチンを無効にします |
|
|
|
|
|
|
ActiveWorkbook.Save
ThisWorkbook.Saved = True ' 「保存しますか」の確認メッセージを避ける |
|
|
|
|
|
|
Application.Quit
この瞬間にExcelは終了しない。終了を「予約」しておいて、その後の一連のプロシージャが終わった所で終了する。
この場合 Auto_Close は実行されない
|
|
|
|
|
|
|
Set myCB_1 = Application.CommandBars("worksheet menu bar")
Set myCBCtl_1 = myCB_1.Controls.Add(Type:=msoControlPopup, Temporary:=True)
myCBCtl_1.Caption = "振替伝票"
With myCBCtl_1
.Controls.Add Type:=msoControlButton
With .Controls(1)
.Caption = "白紙伝票の追加"
.OnAction = "Den_Sakusei"
End With
.Controls.Add Type:=msoControlButton
With .Controls(2)
.Caption = "白紙伝票の挿入"
.OnAction = "Den_Sonyu"
End With
.Controls.Add Type:=msoControlButton
With .Controls(3)
.Caption = "トップ頁へジャンプ"
.OnAction = "Page_Jump_Top"
End With
.Controls.Add Type:=msoControlButton
With .Controls(4)
.Caption = "指定頁へジャンプ"
.OnAction = "Page_Jump"
End With
.Controls.Add Type:=msoControlButton
With .Controls(5)
.Caption = "最終頁へジャンプ"
.OnAction = "Page_Jump_Last"
End With
End With
|
|
|
|
|
|
|
Sub auto_open()
'ツールボックスの非表示
Toolbars(1).Visible = False
Toolbars(2).Visible = False
'警告メッセージOff
Application.DisplayAlerts = False
'画面更新なし
Application.ScreenUpdating = False
'本プログラム名のＧＥＴ
ThisBookName = ActiveWorkbook.Name
'Focus
Worksheets(Sheet1).Activate
Range("A1").Select
End Sub
|
|
|
|
|
|
|
Sub auto_close()
'ツールボックスの表示
Toolbars(1).Visible = True
Toolbars(2).Visible = True
'警告メッセージOn に戻す
Application.DisplayAlerts = True
'画面更新あり に戻す
Application.ScreenUpdating = False
End Sub
|
