モジュール

Goto

 Dim strData As String
   strData = "[[Access]] VBA"
   GoTo Skip
   MsgBox strData  '---実行されない。        
 Skip:
   MsgBox "処理がスキップされました。" 
------------------------------------------------------------------------
StartDelete:
For
  If
    ソース
     GoTo StartDelete
  End If
next

本体左上にあるコントロールメニュー無効2007

   Option Compare Database
   Option Explicit
                  
   Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
   ByVal bRevert As Long) As Long
   
   Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
   
   Const MF_GRAYED = &H1&
   Const MF_BYCOMMAND = &H0&
   Const SC_CLOSE = &HF060&
   Public Function SetEnabledState(blnState As Boolean)
   Call CloseButtonState(blnState)
   End Function
   'Disable the Close Button Option
   Sub CloseButtonState(boolClose As Boolean)
   Dim hWnd As Long
   Dim wFlags As Long
   Dim hMenu As Long
   Dim result As Long
   
   hWnd = Application.hWndAccessApp
   hMenu = GetSystemMenu(hWnd, 0)
   If Not boolClose Then
   wFlags = MF_BYCOMMAND Or MF_GRAYED
   Else
   wFlags = MF_BYCOMMAND And Not MF_GRAYED
   End If
   
   result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
   End Sub
   
   ----------------------------------------------------------------------------------
   Private Sub Form_Open(Cancel As Integer)
       Call SetEnabledState(False)
   End Sub

本体左上にあるコントロールメニュー無効

//Call InvalidSysMenu
//Call InvalidAccessResize でフォームから呼び出す

   Public Declare Function GetSystemMenu Lib "user32" _
           (ByVal hWnd As Long, ByVal bRevert As Long) As Long
   Public Declare Function DeleteMenu Lib "user32" _
           (ByVal hMenu As Long, ByVal nPosition As Long, _
             ByVal wFlags As Long) As Long
   Public Declare Function DrawMenuBar Lib "user32" _
           (ByVal hWnd As Long) As Long
   
   Private Const MF_BYCOMMAND = &H0&       'メニュー項目の識別子
   Private Const MF_BYPOSITION = &H400&    'メニュー項目の番号
   Private Const SC_SIZE = &HF000          '[サイズ変更]コントロールメニュー
   Private Const SC_MOVE = &HF010          '[移動]コントロールメニュー
   Private Const SC_MINIMIZE = &HF020      '[最小化]コントロールメニュー
   Private Const SC_MAXIMIZE = &HF030      '[最大化]コントロールメニュー
   Private Const SC_CLOSE = &HF060         '[閉じる]コントロールメニュー
   Private Const SC_RESTORE = &HF120       '[元に戻す]コントロールメニュー
   
   
   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 Const WS_MINIMIZEBOX = &H20000  '最小化ボタン
   'Private Const WS_MAXIMIZEBOX = &H10000  '最大化ボタン
   Private Const GWL_STYLE = -16
   
   Public Sub InvalidSysMenu()
   
     Dim lngMenuWnd As Long
   
     'コントロールメニューのハンドルを取得
     lngMenuWnd = GetSystemMenu(Application.hWndAccessApp, False)
   
     '[閉じる]メニューを削除
     DeleteMenu lngMenuWnd, SC_CLOSE, MF_BYCOMMAND
     '[閉じる]メニューの上の横線を削除
     DeleteMenu lngMenuWnd, 5&, MF_BYPOSITION
     '[元のサイズに戻す]メニューを削除
   '  DeleteMenu lngMenuWnd, SC_RESTORE, MF_BYCOMMAND
     '[移動]メニューを削除
   '  DeleteMenu lngMenuWnd, SC_MOVE, MF_BYCOMMAND
     '[サイズ変更]メニューを削除
     DeleteMenu lngMenuWnd, SC_SIZE, MF_BYCOMMAND
     '[最小化]メニューを削除
   '  DeleteMenu lngMenuWnd, SC_MINIMIZE, MF_BYCOMMAND
   '  '[最大化]メニューを削除
   '  DeleteMenu lngMenuWnd, SC_MAXIMIZE, MF_BYCOMMAND
     
     '変更を反映させるためメニューを再描画
     DrawMenuBar Application.hWndAccessApp
   
   End Sub
   
   Public Sub InvalidAccessResize()
   
     Dim lngSetValue As Long
   
     '現在の設定値を取得
     lngSetValue = GetWindowLong(Application.hWndAccessApp, GWL_STYLE)
   
     '最小化ボタンを外す
   '  lngSetValue = lngSetValue And Not WS_MINIMIZEBOX
     '最大化ボタンを外す
   '  lngSetValue = lngSetValue And Not WS_MAXIMIZEBOX
   
     '新しい設定値を設定
     SetWindowLong Application.hWndAccessApp, GWL_STYLE, lngSetValue
   
   End Sub

ユーザー名取得

 Private Declare Function WNetGetUser Lib "mpr" Alias "WNetGetUserA" 
 (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
 
 Function NetUserName() As String
 
 Dim strUserName As String * 255
 'WindowsAPIをコールして、ネットワークユーザー名を取得します。
 If WNetGetUser("", strUserName, 255) = 0 Then
 'APIの返り値が正常なら、後続のNullを取り除きます。
 '（これはAPIの関数から値を取得する場合にしばしば使用する定型的な処理です）
   NetUserName = Left$(strUserName, InStr(strUserName, Chr$(&H0)) - 1)
 Else
   NetUserName = ""
 End If
   
 End Function