Hello can you somone tell me how make this macros to run on 32 bit and on 64 bit Office?
on 32 bit macros is run but on 64 bit it not and it is in red color. Thank you.
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long`
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long```
Related
I am using the following code to change word icon in windows taskbar from the usual word icon to an icon I have made.
But it doesn't work...only changes the small icon on the top-left corner of the application or userform.(not the taskbar)
I tried solution on the web including this link(
how to change the Excel Icon in Taskbar while loading,
Cannot change excel icon (in taskbar) with vba) and searched on stackoverflow.com but it couldn't help.
I am using Windows 10 & word 2010(I also tried this code on excel but it was same.)
I hope someone can help....
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As LongPtr, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Declare PtrSafe Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Long
Private Const ICON_SMALL As LongPtr = 0&
Private Const ICON_BIG As LongPtr = 1&
Dim hwndIcon As LongPtr
#Else
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
Declare Function ExtractIcon32 Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const ICON_SMALL As Long = 0&
Private Const ICON_BIG As Long = 1&
Dim hwndIcon As Long
#End If
Private Const WM_SETICON As Long = &H80
Public Sub ChangeApplicationIcon()
bigIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\32X32B32.ico"
smallIcon_Path = ThisDocument.path & "\DataDontTouch\Icon\16X16B32.ico"
bigIcon = ExtractIconA(0, bigIcon_Path, 0)
smallIcon = ExtractIconA(0, smallIcon_Path, 0)
SendMessageA GetActiveWindow32(), &H80, 0&, smallIcon
SendMessageA GetActiveWindow32(), &H80, 1&, bigIcon
ActiveWindow.Caption = "Fast.exe"
End Sub
I was using code that was working fine when I was running the 32-bit version of Excel. After I was switched to the 64-Bit version, the macro broke. I updated the dll calls to use LongPtr everywhere instead of Long.
Is there any way to determine which arguments and return types need to be changed for VBA7, and which don't, for a specific Declare Function?
Here is an example of some of the "Declare Functions" that I have updated (there were actually several more too).
#If VBA7 Then
Private Declare PtrSafe Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As LongPtr, ByVal nWidth As LongPtr, ByVal nHeight As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hdc As LongPtr) As LongPtr
Private Const LOGPIXELSY As Long = 90
#Else
Private Declare CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Const LOGPIXELSY As Long = 90
#End If
This code was adapted from an answer to this question:
vb macro string width
Relevant snippet is copied here below:
Private Function GetLabelSize(text As String, font As StdFont) As SIZE
Dim tempDC As Long
Dim tempBMP As Long
Dim f As Long
Dim lf As LOGFONT
Dim textSize As SIZE
tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
I get a runtime error that just says "Compile Error: Type Mismatch." The function call to CreateDC is highlighted, and the debugger breaks on the function GetLabelSize. I have no idea which variable is now causing the error. I'm also assuming that once I fix this first error, I'll have other errors too.
Do I need to pass the value of that last argument (ByVal 0) as an explicitly typed variable? If so how?
I updated the dll calls to use LongPtr everywhere instead of Long.
You should have not done that.
By adding PtrSafe to a function declaration, you promise to the compiler that you have put LongPtr in all places where it needs to be, and nowhere else.
LongPtr is a pointer-sized integer. It must be used for things that have the same size as a pointer.
To learn which Windows API types should be described as LongPtr, you must look at the original function signature, consult https://learn.microsoft.com/en-us/windows/win32/winprog/windows-data-types, track the used data types through all the typedefs down to the basic types, and use LongPtr for those that are pointers to things.
For the functions that you have shown, that would be
#If VBA7 Then
Private Declare PtrSafe Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hdc As LongPtr) As Long
#Else
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
#End If
When you declare variables to hold your LongPtr results, you need to use #If VBA7 too:
#If VBA7 Then
Dim tempDC As LongPtr
Dim tempBMP As LongPtr
#Else
Dim tempDC As Long
Dim tempBMP As Long
#End If
If you don't have to support Office 2007 and older, you can ditch the #If VBA7s and only use the LongPtr branch.
Im trying to run a macro code but since I'm using a 64 bit Excel 2016 this code is not working. Please help me how to fix this.
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 IIDFromString Lib "ole32" _
(ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long
These should work on 64 bit Excel
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
(ByVal lpsz As LongPtr, ByRef lpiid As GUID) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal Hwnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long
If you need it to run on both you can use the following #If VBA7
#If VBA7 Then
'64 bit declares here
#Else
'32 bit declares here
#End If
A nice resource for PtrSafe Win32 API declares can be found here: Win32API_PtrSafe.txt
We need to do following two code changes:
Replace Long data type with LongPtr, at all places in the
script
You need to change the private function declarations as
below:
OLD:
Private Declare Function GetTimeZoneInformation Lib "kernel32" ( _
lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
NEW:
Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" ( _
lpTimeZoneInformation As TIME_ZONE_INFORMATION) As LongPtr
I wrote a large VBA program which, in a nutshell, calculates the energy need of buildings. It would be way to much code to post here but firstly it reads a configuration file for each building, then loads some heat load profiles from the disk and then dynamically calculates for 35040 quarter hours which heat producers generates what amount of heat.
On Windows 7 with Windows Defender it just runs smooth and fine, no matter what Excel Version (2007, 2010, 2013, 365 tested).
Now, if I'm running the same code on my computer with Windows 10 and Windows Defender (Excel 365), it is slower by an incredible amount (factor 1000 or so it feels). And strangely, everything is way slower, it is not a certain procedure or event. Loading the files and profiles from the disk takes forever, but calculating the energy needs in the loop (where nothing is transferred from/to the drive) is way slower aswell. The GUI isn't refreshing at all and the whole application just seems frozen.
At the same time MsMpEng.exe is on full load, suggesting Windows Defender has a problem. And surprise, having turned off Windows Defender, everything runs fine.
Now, because there are so many classes/modules/etc. it is hard to say, what may be the problem and I can't upload the code. But at least I have a suspicion. Every class has a Parent Property, implemented as depicted here.
The parent property is called very often and all over the code so the extreme slow down would make sense if there was a problem with the CopyMemory-API/Function.
Update 1:
I removed the CopyMemory-Function and replaced all the Parents with Circular References. This is no long term solution, but it solved part of the problem. When I wait long enough the calculation starts at some point and is as fast as it's supposed to be. So the problem could be related to API-Functions in general because I use quite a lot for the GUI, namely
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Public Declare PtrSafe Function GetDeviceCaps Lib "Gdi32" (ByVal hDC As LongPtr, ByVal _
nIndex As Long) As Long
Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal _
hDC As LongPtr) As Long
Public Declare PtrSafe Function GetSystemMetrics32 Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
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 wFlags As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Sub ReleaseCapture Lib "user32" ()
Public Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
Public Declare PtrSafe Function GetActiveWindow32 Lib "user32" Alias "GetActiveWindow" () As Integer
#If Win64 Then
Public Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
Update 2 (which makes the topic in a way solved):
The reason for the loading-part of the program took so long is because I used the JSON-Converter. And as it turns out there was a similar problem. Since I updated the module and removed every other API-Call everything runs fine and smooth. So it is definitly caused by the API-Calls though I don't know why there aren't that many other people complaining about the huge performance issues. And now I can't tweak the GUI in the way I wan't to and I don't really know how to implement the parent property properly.
Is there any way to get display zoom value of Windows? The 200% in the picture is exactly what I would like to get.
This question is only half the means to achieve another purpose, which is formulated in that question: Excel Shape position disturbed by Windows Display Zoom settings
You can retrieve this information with a WIN32-API call
Option Explicit
Private Const LOGPIXELSX As Long = 88
#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) 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 GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex 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 GetActiveWindow Lib "user32" () As Long
Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Long
#End If
Public Function GetDpi() As Long
#If VBA7 Then
Dim hdcScreen As LongPtr
Dim hWnd As LongPtr
#Else
Dim hdcScreen As Long
Dim hWnd As Long
#End If
hWnd = GetActiveWindow()
hdcScreen = GetDC(hWnd)
Dim iDPI As Long
iDPI = -1
If (hdcScreen) Then
iDPI = GetDeviceCaps(hdcScreen, LOGPIXELSX)
ReleaseDC hWnd, hdcScreen
End If
GetDpi = iDPI
End Function
This will result in 192 for eg 200%:
96 – Smaller 100%
120 – Medium 125%
144 – Larger 150%
192 – Extra Large 200%
240 – Custom 250%
288 – Custom 300%
384 – Custom 400%
480 – Custom 500%