Tutorialized Stuffs

The following code snippet allows to manipulate the system tray by adding your apps icon when you minimize the form and restore when you double click on the app's icon on the system tray area.

Option Explicit

Public Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
Public Const WM_LBUTTONDOWN = &H201 'Button down
Public Const WM_LBUTTONUP = &H202 'Button up
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
Public Const WM_RBUTTONDOWN = &H204 'Button down
Public Const WM_RBUTTONUP = &H205 'Button up
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'Dimension a variable as the user-defined data type.
Dim nid As NOTIFYICONDATA

This sub sends the icon to system tray.

Sub minToTray()
    '------------------------
    '--- create tray icon ---
    '------------------------

    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uId = vbNull
    nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    nid.uCallBackMessage = WM_MOUSEMOVE
    nid.hIcon = Main.Icon  'the icon will be your Form1 project icon
    nid.szTip = TrayName   'tip text
    
    'adds the icon to the taskbar area
    Shell_NotifyIcon NIM_ADD, nid
    
End Sub

'This is Tip text when hovering on the system tray icon 
Function TrayName() as String
    TrayName = App.EXEName & " Ver." & App.Major & "." & App.Minor & vbCrLf & App.CompanyName & vbNullChar
End Function

When the minimize button is clicked it will hide the form and send icon to system tray.

Private Sub imgMin_Click()       
    'Hides main form and shows mini mode
    Me.Hide
    minToTray   'send icon to system tray   
End Sub

When the app icon on the system tray is doubled click it will show the form and delete the icon from the system tray.

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Msg As Long
    Dim sFilter As String
    Msg = x / Screen.TwipsPerPixelX

        Select Case Msg
            Case WM_LBUTTONDOWN 
            Case WM_LBUTTONUP
            Case WM_LBUTTONDBLCLK
                Me.Show
                Me.WindowState = vbNormal
              
                'Deletes the tray icon when the form is shown
                Shell_NotifyIcon NIM_DELETE, nid ' del tray icon
            Case WM_RBUTTONDOWN
                'Show popup menu
                PopupMenu mExit
            Case WM_RBUTTONUP
            Case WM_RBUTTONDBLCLK
        End Select
  
End Sub

The following code snippets allows to set Windows Form Always on Top of Other applications in Visual Basic 6.0.

Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Declare Function SetWindowPos Lib "user32" _
      (ByVal hWnd As Long, _
      ByVal hWndInsertAfter As Long, _
      ByVal x As Long, _
      ByVal y As Long, _
      ByVal cx As Long, _
      ByVal cy As Long, _
      ByVal wFlags As Long) As Long

The following SetTopMostWindow() function takes two parameters as follows:
hWnd: the window handle
Topmost: It is either True to set the on top or False if Not.

Public Function SetTopMostWindow(hWnd As Long, Topmost As Boolean) As Long

   If Topmost = True Then 'Make the window topmost
      SetTopMostWindow = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
   Else
      SetTopMostWindow = SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
      SetTopMostWindow = False
   End If
End Function

The following Sub sets the form frmMini on Top of any other applications.

Private Sub Form_Load()
Dim lR As Long
lR = SetTopMostWindow(frmMini.hWnd, True)
End Sub

The following code snippets allows you to make windows form transparent using VB6.

In a standard module, copy and paste the following declarations and function.
[Module1.bas]

Option Explicit

Const LWA_COLORKEY = 1
Const LWA_ALPHA = 2
Const LWA_BOTH = 3
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = -20

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
        x As Long
        y As Long
End Type

Private pPoint As POINTAPI
Private hMouseOverWnd As Long
Public Trans As Integer

Public Function SetTrans(hWnd As Long, Trans As Integer)

    Dim Tcall As Long

    If Trans <= 0 Then
        Exit Function
    Else
        Tcall = GetWindowLong(hWnd, GWL_EXSTYLE)
        SetWindowLong hWnd, GWL_EXSTYLE, Tcall Or WS_EX_LAYERED
        SetLayeredWindowAttributes hWnd, RGB(255, 255, 0), Trans, LWA_ALPHA
    End If

End Function

To apply the transparency, you can call the SetTrans() function on Form_Load() event of the form you want to be transparent.
[Form Code]

Private Sub Form_Load()
SetTrans frmMain.hWnd, 220
End Sub

Internet Speed Booster is just right for you for FREE.

Internet Speed Booster is available for free download.

The following function below allows you to get the number of visible rows from a filtered sets of rows in Excel using VBA. The function takes two arguments which is the Column and StartRow. Calling the FilterCount() function returns the number of visible rows. Also added an error handler which process the error description to determine if there's a visible row.

Parameters:
Column: The column of the data to be filtered. If you have multiple columns being filtered you can just set the first Column or any column in the dataset.
        StartRow: Start row of the data to be filtered.

Function FilterCount(ByVal Column As String, ByVal StartRow As Long) As Long

    On Error GoTo errHandler
  
    FilterCount = Application.WorksheetFunction.CountA(ActiveSheet.Range(Column & StartRow, Cells(ActiveSheet.UsedRange.Rows.Count, Range(Column & StartRow).Column)).SpecialCells(xlCellTypeVisible))

    'Debug.Print FilterCount
  
Exit Function
errHandler:
    If Err.DESCRIPTION = "No cells were found." Then
        'Set count to 0
        FilterCount = 0
    End If
  
    'Debug.Print FilterCount
  
End Function

Usage: 

Sub Count()
    Debug.Print FilterCount "A", 20
End Sub

Where:
          "A" - is the column or first column in the column lists.
           20  - is the start row of the data set.

You might be working on a project where you need to filter sets of data and create a raw data of that filtered sets of data to a new sheet or range.

By default, Excel copies hidden or filtered cells in addition to visible cells. If some cells, rows, or columns on your worksheet are not displayed, you have the option of copying all cells or only the visible cells. 

Public Function GetFilteredData()
    Dim rawWs As Worksheet            'RAW DATA WORKSHEET
    Dim tarWs As Worksheet            'TARGET WORKSHEET
    
    'Replace this with your actual Worksheets
    Set rawWs = Sheets("Raw Data")    
    Set tarWs = Sheets("Filtered Data Visualizations")
    
    Application.ScreenUpdating = False

    'Clear old contents of the Target Worksheet
    tarWs.Range("A2:N" & Rows.Count).ClearContents
    
    '****************************************************
    ' Select Raw Data Sheet and
    ' Copy only the visible rows if filter is applied
    '
    rawWs.Select
    Range("A2", Cells(ActiveSheet.UsedRange.Rows.Count, Range("N2").Column)).SpecialCells(xlCellTypeVisible).Copy
    
    '****************************************************
    'Select the Target worksheet and
    'Paste the copied data
    '
    tarWs.Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    Range("A2").Select
    Application.ScreenUpdating = True
End Function