Option Explicit
Public Bln_Err As Boolean
Public ErrProsName As String
Public wb As Workbook
Public wsMain As Worksheet
Public wsCtrl As Worksheet
Sub SetObject()
Set wb = ThisWorkbook
Set wsMain = wb.Worksheets("Main")
End Sub
Sub ReSetObject()
Set wb = Nothing
Set wsMain = Nothing
End Sub
'*****************************************************
' 画面制御セット
'*****************************************************
Public Sub StopUpdating()
With Application
.ScreenUpdating = False '画面描画停止
.EnableEvents = False 'イベント動作停止
.EnableCancelKey = xlInterrupt '[Esc]キーでエラーをトラップする
'=========================
'.EnableCancelKey = xlErrorHandler '[Esc]キーでエラーをトラップする
' .EnableCancelKey = xlDisabled '[Esc]キーでの中断を無視する
'=========================
'.Cursor = xlWait
.DisplayAlerts = False '警告非表示
.DisplayStatusBar = True 'ステータスバーを表示
End With
End Sub
'*****************************************************
' 画面制御セット
'*****************************************************
Public Sub Updating()
With Application
.ScreenUpdating = True '画面描画再開
.EnableEvents = True 'イベント動作再開
.Cursor = xlDefault
.DisplayAlerts = True '警告再表示
.StatusBar = "" 'ステータスバーを表示
End With
End Sub
'-----------------------------------------------------
' ステータスバーの使用
'-----------------------------------------------------
Public Sub showStatus(ByVal msg As String)
'エラーを無視
On Error Resume Next
Application.StatusBar = msg
'エラー制御を戻す
On Error GoTo 0
End Sub
'-----------------------------------------------------
' ステータスバー表示をクリア
'-----------------------------------------------------
Public Sub ClearStatus()
'エラーを無視
On Error Resume Next
Application.StatusBar = False
'エラー制御を戻す
On Error GoTo 0
End Sub
'-----------------------------------------------------
' OSに制御を渡す
' 【esc】キーで止まらないので、使用中止
'-----------------------------------------------------
Public Sub exeBreak()
'エラーを無視
On Error Resume Next
DoEvents
'エラー制御を戻す
On Error GoTo 0
End Sub
'+++***********************************************+++
' シート検出
' Call IsShtOwb(shtName, wbName )
'+++***********************************************+++
Public Function IsShtOwb(shtName As String, wbName As String) As Boolean
Dim sht As Worksheet
Dim Owb As Workbook
IsShtOwb = False
Set Owb = Workbooks(wbName)
For Each sht In Owb.Worksheets
If sht.Name = shtName Then
IsShtOwb = True
Set Owb = Nothing
Exit Function
End If
Next sht
'エラーを無視
On Error Resume Next
Set Owb = Nothing
'エラー制御を戻す
On Error GoTo 0
End Function
' +++*******************************************************+++
' アクティブシートのシェイプを全削除
' +++*******************************************************+++
Public Sub delShapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
End Sub
コメント