Print UserForm with Height of 2500 onto either several pages or squeezed onto 1 page.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,427
Office Version
2016
Platform
Windows
Back to this thread.

The code in post #3 doesn't seem to work at least on my excel 2016 64bit... I have rewritten the entire code and hopefully it should now work as expected. This is not an elegant solution but, hopefully, a working hack.

Basically, the code grabs a screen capture of the entire userform's client area and place the resulting bitmap in the clipboard.

Additionally, it permits pasting the capture to the worksheet as a shape and\or saving it to disk as bmp file.


Workbook Example Update.


1- API code in a Standard Module:
Code:
Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
End Type

Private Type uPicDesc
    Size As Long
    Type As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
       hPic As Long
       hPal As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As Any, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
    Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As LongPtr) As LongPtr
    Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hDc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function ScreenToClient Lib "user32" (ByVal hwnd As LongPtr, lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect64 Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect32 Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Private Declare PtrSafe Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPtr
    Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDc As LongPtr, ByVal nBkMode As Long) As Long
    Private Declare PtrSafe Function SetTextColor Lib "gdi32" (ByVal hDc As LongPtr, ByVal crColor As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As any, phwnd As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function OleCreatePictureIndirect64 Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirect32 Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
    Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hDc As Long, ByVal nBkMode As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hDc As Long, ByVal crColor As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If



Public Function IPictureFromUserForm( _
        ByVal UForm As Object, _
        Optional ByVal PasteToNewSheetAsShape As Boolean, _
        Optional ByVal SaveBmpToFilePathName As String _
    ) _
    As IPicture

    Const SRCCOPY = &HCC0020
    Const SM_CYDLGFRAME = 8
    Const SM_CYCAPTION = 4
    Const SM_CXVSCROLL = 2

    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim hwnd As LongPtr, hDc As LongPtr, hMemDC As LongPtr, hBmp As LongPtr
        Dim hScreenDc As LongPtr, hScreenMemDc As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hwnd As Long, hDc As Long, hMemDC As Long, hBmp As Long
        Dim hScreenDc As Long, hScreenMemDc As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim tClientRect As RECT
    Dim lWidth As Long, lHeight As Long, lInitScrollBarVal As Long
    Dim sngVal As Single, sngPrevScrollTop As Single
    Dim YOffset As Long    
    
    On Error GoTo errHandler
    With UForm
        .ScrollTop = 0
        lInitScrollBarVal = .ScrollBars
        .ScrollBars = fmScrollBarsVertical
        DoEvents
        Call WindowFromAccessibleObject(UForm, hwnd)
        Call GetClientRect(hwnd, tClientRect)
        sngVal = IIf(.ScrollHeight >= .InsideHeight, .ScrollHeight, .InsideHeight)
        With tClientRect
            lWidth = .Right - .Left - GetSystemMetrics(SM_CXVSCROLL): lHeight = PTtoPX(CDbl(sngVal), True)
        End With
        hDc = GetDC(hwnd)
        hMemDC = CreateCompatibleDC(0)
        hBmp = CreateCompatibleBitmap(hDc, lWidth, lHeight)
        Call DeleteObject(SelectObject(hMemDC, hBmp))
        Call BitBlt(hMemDC, 0, 0, lWidth, lHeight, hDc, tClientRect.Left, tClientRect.Top, SRCCOPY)
        DisableClientAreaUpdate(hwnd, hScreenDc, hScreenMemDc) = True
        Call ShowProgress(hScreenMemDc, tClientRect)
        DoEvents
        sngPrevScrollTop = 0
        Do
            DoEvents
            sngPrevScrollTop = .ScrollTop
            .Scroll 0, fmScrollActionPageDown
            .Repaint
            YOffset = GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME)
            Call BitBlt(hMemDC, 0, PTtoPX(.ScrollTop, True) + YOffset, _
            lWidth, lHeight, hDc, tClientRect.Left, tClientRect.Top + YOffset, SRCCOPY)
            Call FreezeClientAreaNow(hwnd, hScreenDc, hScreenMemDc)
            'Sleep 1000 '<== Edit for testing
        Loop Until sngPrevScrollTop >= .ScrollTop
        .ScrollBars = lInitScrollBarVal
        .ScrollTop = 0
    End With
    Set IPictureFromUserForm = CreatePicture(hBmp, PasteToNewSheetAsShape, SaveBmpToFilePathName)
    
errHandler:
    DisableClientAreaUpdate(hwnd, hScreenDc, hScreenMemDc) = False
    Call ReleaseDC(0, hDc)
    Call DeleteObject(hMemDC)
    Call DeleteObject(hBmp)
    
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Sub ShowProgress(ByVal hDc As LongPtr, ByRef tRect As RECT)
    
    Dim hNewFont As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Sub ShowProgress(ByVal hDc As Long, ByRef tRect As RECT)
    
    Dim hNewFont As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Const SM_CYCAPTION = 4
    Const SM_CYDLGFRAME = 8
    Dim tFont As LOGFONT, sCopying As String, YOffset As Long
    
    sCopying = "Capturing UserForm Screen ... Please Wait"
    With tFont
        .lfHeight = 18: .lfFaceName = "Arial" & Chr(0): .lfWeight = 900
    End With
    hNewFont = (CreateFontIndirect(tFont))
    Call DeleteObject(SelectObject(hDc, hNewFont))
    Call SetTextColor(hDc, vbRed)
    Call SetBkMode(hDc, 1)
    YOffset = GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME) + 10
    Call TextOut(hDc, tRect.Left + 20, tRect.Top + YOffset, sCopying, Len(sCopying))
    
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Property Let DisableClientAreaUpdate(ByVal hwnd As LongPtr, ByRef hDc As LongPtr, _
    ByRef hMemDC As LongPtr, Enable As Boolean)
    
    Static hBmp As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Property Let DisableClientAreaUpdate(ByVal hwnd As Long, ByRef hDc As Long, _
    ByRef hMemDC As Long, Enable As Boolean)
    
    Static hBmp As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Const SRCCOPY = &HCC0020
    Const GWL_EXSTYLE = (-20)
    Const WS_EX_LAYERED = &H80000
    Const LWA_ALPHA = &H2&
    Dim tWndRect As RECT
    
    If Enable Then
        With tWndRect
            Call GetWindowRect(hwnd, tWndRect)
            hDc = GetDC(0)
            hMemDC = CreateCompatibleDC(0)
            hBmp = CreateCompatibleBitmap(hDc, .Right - .Left, .Bottom - .Top)
            Call DeleteObject(SelectObject(hMemDC, hBmp))
            Call BitBlt(hMemDC, 0, 0, .Right - .Left, .Bottom - .Top, hDc, .Left, .Top, SRCCOPY)
        End With
    Else
        Call ReleaseDC(0, hDc)
        Call DeleteObject(hMemDC)
        Call DeleteObject(hBmp)
    End If
    Call SetWindowLong(hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(hwnd, 0, IIf(Enable, 0, 255), LWA_ALPHA)

End Property


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Sub FreezeClientAreaNow(ByVal hwnd As LongPtr, ByVal hDc As LongPtr, hMemDC As LongPtr)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Sub FreezeClientAreaNow(ByVal hwnd As Long, ByVal hDc As Long, hMemDC As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Const SRCCOPY = &HCC0020
    Dim tWndRect As RECT

    GetWindowRect hwnd, tWndRect
    With tWndRect
        If GetActiveWindow = hwnd Or GetActiveWindow = Application.hwnd Then
            Call BitBlt(hDc, .Left, .Top, .Right - .Left, .Bottom - .Top, hMemDC, 0, 0, SRCCOPY)
        End If
    End With

End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function CreatePicture(ByVal BMP As LongPtr, Optional ByVal PasteToNewSheetAsShape As Boolean, _
    Optional ByVal SaveBmpToFilePathName As String) As IPicture
    
    Dim hCopy As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function CreatePicture(ByVal BMP As Long, Optional ByVal PasteToNewSheetAsShape As Boolean, _
    Optional ByVal SaveBmpToFilePathName As String) As IPicture
    
    Dim hCopy As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Const IMAGE_BITMAP = 0
    Const PICTYPE_BITMAP = 1
    Const LR_COPYRETURNORG = &H4
    Const CF_BITMAP = 2
    Const S_OK = 0
    Dim lRet As Long
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim iPic As IPicture

    hCopy = CopyImage(BMP, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hCopy
        .hPal = 0
    End With
    
    If InStr(1, Application.OperatingSystem, "32-bit") Then
        lRet = OleCreatePictureIndirect32(uPicinfo, IID_IDispatch, True, iPic)
    End If
    
    If InStr(1, Application.OperatingSystem, "64-bit") Then
        lRet = OleCreatePictureIndirect64(uPicinfo, IID_IDispatch, True, iPic)
    End If
    
    If lRet = S_OK Then
        Set CreatePicture = iPic
            If Not ThisWorkbook.ProtectStructure Then
                Call OpenClipboard(0)
                Call EmptyClipboard
                Call SetClipboardData(CF_BITMAP, BMP)
                Call CloseClipboard
                If PasteToNewSheetAsShape Then
                    ThisWorkbook.Worksheets.Add.Paste
                End If
        End If
        If Len(SaveBmpToFilePathName) Then
            Call stdole.SavePicture(iPic, SaveBmpToFilePathName)
        End If
    End If
    
End Function


Private Function ScreenDPI(bVert As Boolean) As Long
    Const LOGPIXELSY = 90
    Const LOGPIXELSX = 88
    Static lDPI(1), lDC
    
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function
 
Private Function PTtoPX(Points As Double, bVert As Boolean) As Long
    Const POINTS_PER_INCH = 72
    PTtoPX = Points * ScreenDPI(bVert) / POINTS_PER_INCH
End Function


2- Code Usage example in the UserForm Module:
Code:
Option Explicit

Private Sub CommandButton1_Click()

    Dim iPic As IPicture
    
    'Take a screen capture of the entire userform client area
    'and place it in the clipboard.
    Set iPic = IPictureFromUserForm(UForm:=Me)
    
    If Not iPic Is Nothing Then
        MsgBox "Picture successfully created and copied to clipboard !", vbInformation
    Else
        MsgBox "Failed to create Picture Object.", vbExclamation
    End If
    
End Sub
Hope you this can be of use to others.

Regards.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,427
Office Version
2016
Platform
Windows
Correction in API declarations :

Updated workbook example.

Code:
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
   [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
 

Forum statistics

Threads
1,078,464
Messages
5,340,462
Members
399,376
Latest member
Tresfjording

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top