Хитрости
Замена системных цветов на свои собственные
  	 

На пустую форму положите этот код:
 

Option Explicit
Private Declare Function SetSysColors Lib "user32" _
(ByVal nChanges As Long, lpSysColor As _
Long, lpColorValues As Long) As Long

Private Declare Function GetSysColor& Lib "user32" (ByVal nIndex As Long)


'Можно использовать следующие константы

Private Const COLOR_SCROLLBAR = 0 'The Scrollbar colour
Private Const COLOR_BACKGROUND = 1 'Colour of the background with no wallpaper
Private Const COLOR_ACTIVECAPTION = 2 'Caption of Active Window
Private Const COLOR_INACTIVECAPTION = 3 'Caption of Inactive window
Private Const COLOR_MENU = 4 'Menu
Private Const COLOR_WINDOW = 5 'Windows background
Private Const COLOR_WINDOWFRAME = 6 'Window frame
Private Const COLOR_MENUTEXT = 7 'Window Text
Private Const COLOR_WINDOWTEXT = 8 '3D dark shadow (Win95)
Private Const COLOR_CAPTIONTEXT = 9 'Text in window caption
Private Const COLOR_ACTIVEBORDER = 10 'Border of active window
Private Const COLOR_INACTIVEBORDER = 11 'Border of inactive window
Private Const COLOR_APPWORKSPACE = 12 'Background of MDI desktop
Private Const COLOR_HIGHLIGHT = 13 'Selected item background
Private Const COLOR_HIGHLIGHTTEXT = 14 'Selected menu item
Private Const COLOR_BTNFACE = 15 'Button
Private Const COLOR_BTNSHADOW = 16 '3D shading of button
Private Const COLOR_GRAYTEXT = 17 'Grey text, of zero if dithering is used.
Private Const COLOR_BTNTEXT = 18 'Button text
Private Const COLOR_INACTIVECAPTIONTEXT = 19 'Text of inactive window
Private Const COLOR_BTNHIGHLIGHT = 20 '3D highlight of button

Dim OldColor As Long

Private Sub Form_Load()
    'Эапоминаем текущий цвет
    OldColor = GetSysColor(COLOR_ACTIVECAPTION)
    
    SetSysColors 1, COLOR_ACTIVECAPTION, RGB(255, 0, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Восстанавливаем текущий цвет
    SetSysColors 1, COLOR_ACTIVECAPTION, OldColor
End Sub

 
Как перезагрузить Windows
  	 

Разместите в модуле:
 

   Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
     ByVal dwReserved As Long) As Long

   Public Const EWX_LOGOFF = 0
   Public Const EWX_SHUTDOWN = 1
   Public Const EWX_REBOOT = 2
   Public Const EWX_FORCE = 4


А это в коде:
 

   Dim s As Long

   'Так можно сделать Shut down
    s = ExitWindowsEx(EWX_SHUTDOWN, 0&)

   'Так можно сделать Log off   s = ExitWindowsEx(EWX_LOGOFF, 0&)

   'А так Reboot    s = ExitWindowsEx(EWX_REBOOT, 0&

 
 
Как ловить нажатия на клавиши вне вашей программы
  	 

1. Положите на форму таймер, поставьте интервал в 50
2. Добавьте в модуль:
 

   Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
   
   Public Const VK_TAB = &H9 ' Константа для TAB key.   
                             ' константы для других кнопок посмотрите в API вьювере
   ' Поместите в событие Timer:   
   If GetAsyncKeyState(VK_TAB) And KEY_SHIFT = True Then
        msgboх "Кто то трогает ТАБ", vbinformation
   End If

 
 

Получение Скриншота из кода

Способ основан на симуляции нажатия клавиши Print Screen (Const vbKeySnapshot = 44 (&H2C)), - для копирования изображения экрана, и методе Clipboard.GetData(vbCFBitmap), - для дальнейшего получения изображения в Picture (Picture Box).

'Объявляем в General Form1:

Private Declare Sub keybd_event Lib "user32" _

(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _

ByVal dwExtraInfo As Long)

Dim A As Integer

'в Properties Form1 устанавливаем BorderStyle в 0-None, для того, чтобы в

'момент получения «фотографии» экрана, детали формы не попали в «кадр»

Private Sub Form_Load()

   'делаем форму невидимой, но при этом оставляем активными все 'компоненты

   Form1.Height = 0

   Timer1.Interval = 1

   'очищаем Clipboard

   Clipboard.Clear

   'копируем изображение экрана

   keybd_event vbKeySnapshot, 1, 0&, 0&

End Sub

 

Private Sub Timer1_Timer()

   A = A + 1

   If A = 2 Then

      'вклеиваем изображение в картинку

      Picture1.Picture = Clipboard.GetData(vbCFBitmap)

      'задаём размеры формы и картинки

      Form1.Width = Screen.Width * 0.8

      Form1.Height = Screen.Height * 0.8

      Form1.Left = (Screen.Width - Width) / 2

      Form1.Top = (Screen.Height - Height) / 2

      Picture1.Height = Form1.ScaleHeight * 1

      Picture1.Width = Form1.ScaleWidth * 1

      Picture1.Left = (Form1.Width - Picture1.Width) / 2

      Picture1.Top = (Form1.Height - Picture1.Height) / 2

   End If

   If A = 2 Then

      'очищаем Clipboard

      Clipboard.Clear

      'выключаем Timer1

      Timer1.Enabled = False

   End If

End Sub

 

'для выхода из программы

Private Sub Picture1_Click()

   End

End Sub










Глюк в ExistDir

При разработке приложений в VB или VBA часто возникает потребность в функциях ExistFile и ExistDir, проверяющих существование файла или папки. В литературе встречаются такие примеры:

Public Function ExistFile(ByVal strFileName As String) As Boolean

  ExistFile = False

  On Error GoTo f1

  ExistFile = (Dir(strFileName) <> "")

f1:

  On Error GoTo 0

End Function

 

Public Function ExistDir(ByVal dirName As String) As Boolean

  ExistDir = False

  On Error GoTo f1

    If Len(dirName) < 2 Then GoTo f1

    If Right(dirName, 1) = "\" Then dirName = Left(dirName, Len(dirName) - 1)

    ExistDir = (Dir(dirName, vbDirectory) <> "")

f1:

  On Error GoTo 0

End Function

Однако, при попытке применить функцию ExistDir к сетевым путям, обнаруживается, что она работает неверно, возвращая, например, False для существующей папки \\MAIN\POST$.
Небольшая модификация этой функции позволяет использовать ее как для обычных, так и сетевых путей:

Public Function ExistDir(ByVal dirName As String) As Boolean

  ExistDir = False

  On Error GoTo f1

    If Len(dirName) < 2 Then GoTo f1

    If Right(dirName, 1) = "\" Then dirName = Left(dirName, Len(dirName) - 1)

    If Left(dirName, 2) = "\\" Then

      ExistDir = (Dir(dirName + "\", vbDirectory) <> "")

      Else

      ExistDir = (Dir(dirName, vbDirectory) <> "")

    End If

f1:

  On Error GoTo 0

End Function

Простой способ открыть файл, связанный с каким либо приложением Windows

Shell "start c:\mydoc\example.doc"

' Декларация функции для запуска файла.

Public Declare Function ShellExecute Lib "shell32.dll" Alias _

                        "ShellExecuteA" (ByVal hwnd As Long, _

                         ByVal lpOperation As String, _

                         ByVal lpFile As String, _

                         ByVal lpParameters As String, _

                         ByVal lpDirectory As String, _

                         ByVal nShowCmd As Long) As Long

 

' Декларация константы для максимизирования окна открываемого приложения.

' Для работы с другими константами смотрите MSDN.

Public Const SW_SHOWMAXIMIZED = 3

 

'После этого нижеследующий код будет открывать файл test.xls.

 

Call ShellExecute(0, "open", "test.xls","", "", SW_SHOWMAXIMIZED)