I am working on a UserForm and I am trying to use an IE/Chrome etc logo in the caption property of the UserForm so that the logo is displayed in the window frame followed by some text.
I have done some browsing and have found the following code online but I get an sub/function not defined error on the line involving ExtractIcon.
UserForm Code
Private Sub UserForm_Initialize
Dim strIconPath As String
Dim lngIcon As Long
Dim lnghWnd As Long
' Change to the path and filename of an icon file
strIconPath = "C:\Users\suttond\Desktop\Picture2.gif"
' Get the icon from the source
lngIcon = ExtractIcon(0, strIconPath, 0)
' Get the window handle of the userform
lnghWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
'Set the big (32x32) and small (16x16) icons
SendMessage lnghWnd, WM_SETICON, True, lngIcon
SendMessage lnghWnd, WM_SETICON, False, lngIcon
End Sub
Module Code
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function ExtractIcon _
Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Private Const WM_SETICON = &H80
Essentially a small IE Explorer logo would display to the left of text already in the caption.
Edit
Module code functions updated to public to allow them to be called from the initialize code. No longer getting the extract error but the image is not appearing in the UserForm caption.
As Mistella and Rory mentioned in the comments of your questions, the functions and the constant needs to be declared as Public. If you declare them as Private, they are only known within the Module, but not in the Form.
Second thing is you need to read the Icon from an ICO-file, not from a gif, so you need to convert it. I use IrfanView for tasks like this, but there are tons of tools (even online) available. I did a quick test and it worked:
Related
I have a macro which does manipulations on the ribbon. Because it looks awkward for the user to see rapid automated actions on the ribbon, I would like to cover up the ribbon while the macro is running with a control form or some sort of a filled rectangle. Can you please suggest a solution for that?
EDIT: I tried creating a modeless form and positioned it over the ribbon. Unfortunately, as the macro runs, the actions still flicker through and their z-order seems to overpower that of the user form. I think I've exhausted everything considering this other post of mine, but who knows maybe there's something out there that will do the trick.
EDIT 2: As you can see in the GIF above, the macro actions still flicker through over the modeless user form even after setting the window position as top most, as suggested. I also tried showing and re-positioning the form after expanding the ribbon, but that causes a run-time error as the UI automation framework is not able to track-down the UI elements it needs to operate on next.
To display a userform over a certain portion of the screen to cover something while code will do something to the ribbon behind it, we'll need a modeless userform.
As opposed to a modal userform, the modeless userform has the following advantage since it is a seperate window: It can be displayed on top of the Excel window while the Excel Window keeps the focus.
Let's say the name of the userform is frmCoverScreen. To invoke it as a modeless userform, we'd do:
frmCoverScreen.Show vbModeless
Now, we need to use the SetWindowPos function from the Windows API in order to make the form appear on top of the Excel Window at all times. We're also going to need the FindWindow function to get the window handle of our userform. You can include the following code to declare the function in your project (top of module):
#If VBA7 Then
'VBA version 7 compiler, therefore >= Office 2010
'PtrSafe means function works in 32-bit and 64-bit Office
'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
Public Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal hWndInsertAfter As LongPtr, _
ByVal x As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#Else
'VBA version 6 or earlier compiler, therefore <= Office 2007
Public 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 uFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If
You can then include the following constants and variable that will be used inside the SetWindowPos function:
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1
#If VBA7 Then
Public WinHandle As LongPtr
#Else
Public WinHandle As Long
#End If
Hence, we can now get the window handle of our userform:
If Val(Application.Version) >= 9 Then
WinHandle = FindWindow("ThunderDFrame", frmCoverScreen.Caption)
Else
WinHandle = FindWindow("ThunderXFrame", frmCoverScreen.Caption)
End If
And now having the handle, we can make the userform window appear on top of Excel at all times using the following:
SetWindowPos WinHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
Then we only need to set the .Top , .Left , .Width and .Height properties of the userform to make sure it covers the part of the screen we need to cover.
Finally, when we no longer need to cover the screen, we can simply unload the form:
Unload frmCoverScreen
I have this link:
https://s23527.pcdn.co/wp-content/uploads/2017/04/wine_speedlights_kit_lens.jpg.optimal.jpg
It is on Cell A2:
I want to get on Cell B2 the dimensions of the URL of this JPG
(I don't mind how to get it, it can be 1920 on cell B2 and 1080 on cell C2)
You will need to make an API call to URLDownloadToFile to download your image. In the below example, we will download to the temp folder C:\Temp\.
Once your image is downloaded, you will create a new Shell object, and ultimately use the .ExtendedProperty() property to grab your file dimensions
After you have finished downloading your file, you can go ahead and delete the temporary file using Kill().
The below method uses Early Binding. You will need to set a reference to
Microsoft Shell Controls And Automation
By going to Tools -> References in the VBE menu
Option Explicit
#If VBA7 Then
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Sub test()
Const tmpDir$ = "C:\Temp\"
Const tmpFile$ = "tmpPicFile.jpg"
Debug.Print URLDownloadToFile(0, ActiveSheet.Range("A2").Value, tmpDir & tmpFile, 0, 0)
ActiveSheet.Range("B2").Value = getFileDimensions(tmpDir, tmpFile)
Kill tmpDir & tmpFile
End Sub
Private Function getFileDimensions(filePath$, fileName$) As String
With New Shell32.Shell
With .Namespace(filePath).ParseName(fileName)
getFileDimensions = .ExtendedProperty("Dimensions")
End With
End With
End Function
I have an Excel workbook that sends information to another application (via VBA), which in turn produces a pop-up window with the results of that information, and which I then need for my Excel workbook. Is there any way to have Excel read the information from that other application's pop-up window and paste it into itself?
[]
Here is a picture of the dialog box. What I need is the date and time from it.
It's from a program that was written in VB6. It produces its own popup window. It looks like a custom dialog box.
I don't have access to the outside application's code. It looks like a proprietary program written in VB6 that has its own function buttons, one of which does the calculations with the inputted data, then creates a dialog box with the calculated data. There are no fields in the dialog box to grab the data, it's simply just a box containing data with an "OK" button. Right now, we copy the values down manually, then move on to the next calculation.
Thanks for your help :)
This worked for me, using a test dialog from a .NET Windows Forms project.
The dialog caption was "Tester!" and it contained a single label with some text.
Your situation will be a little different: you will need to determine the "class" of the control containing the text you need. You can use Spy++ for this.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Sub main()
Dim lngHWnd As Long
Dim lngHWndChild As Long
Dim lngIndex As Long
Dim lngDlgItem As Long
Dim lngTextLength As Long
Dim strText As String
lngHWnd = FindWindow(vbNullString, "Tester!")
lngHWndChild = FindWindowEx(lngHWnd, 0&, "WindowsForms10.STATIC.app.0.3ee13a2_r17_ad1", vbNullString)
lngTextLength = GetWindowTextLength(lngHWndChild)
strText = Space(lngTextLength)
GetWindowText lngHWndChild, strText, lngTextLength + 1
Debug.Print strText
End Sub
Spy++ - press Alt+F3 then drag the "target" onto the dialog to locate it in the tree.
I have a question I am unable to find the answer to. I have a macro that imports data from a .MHTML file into my worksheet (Using the .MHTML file is my only option unfortunately. It is an export from SAP and opens in Excel but is not recognized as an Excel file due to file extension type.). At the end of the macro I wouuld like to close it. It is not recognized as an excel workbook so I am unable to use the simple: Workbooks().close command.
Does anyone have any ideas on how to do this? Thanks in advance.
I was able to find this code and after changing the Caption to match what is shown in Task Manager, it worked: http://www.vbforums.com/showthread.php?208430-Use-sendmessage-to-close-an-application
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Sub ExportClose()
Dim CloseIt As Long
CloseIt = FindWindow(vbNullString, "Microsoft Excel - SAP_export.MHTML")
PostMessage CloseIt, WM_CLOSE, CLng(0), CLng(0)
End Sub
Note: This works great for my system but not for my colleague
.. Currently trying to figure out why
Maybe try just:
Windows("SAP_export.MHTML").Close
Is there any option to change the excel icon in taskbar for Excel?
Disclaimer: I usually do not answer questions where the OP has shown no efforts but this was way too interesting to pass on. But do not be surprised if this question gets closed :)
Is there any option to change the excel icon in taskbar for Excel
Yes there is. You have to use 3 APIs for this
ExtractIcon32, GetActiveWindow32 and SendMessage32
To read about them see THIS LINK. This is my favorite one stop for APIs :)
Declare Function ExtractIcon32 Lib "shell32.dll" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Declare Function GetActiveWindow32 Lib "user32" _
Alias "GetActiveWindow" () As Integer
Declare Function SendMessage32 Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Sub Sample()
Dim myIcoFile As String
Dim NewIco
'~~> Change this to the relevant icon file
myIcoFile = "D:\Temp\icons\CHARACT\$SIGN1.ico"
NewIco = ExtractIcon32(0, myIcoFile, 0)
SendMessage32 GetActiveWindow32(), &H80, 1, NewIco
End Sub