I got my project 95% done but a small issue remains. My code, run from a user form, opens a PDF document with its first line, identifies its window in the second and moves and resizes that window in the third.
ActiveWorkbook.FollowHyperlink Mail(0) & Mail(Me.Tag)
Wnd = FindWindow(vbNullString, AcrobatWindowID(Mail(Me.Tag)))
SetWindowPos Wnd, HWND_TOP, 1950, 10, 1100, 1300, SWP_NOACTIVATE
At the end of this operation the user form is dimmed out. The focus seems to remain with the PDF. That doesn't really matter because the form is fully developed and I can click on it or the PDF to activate either, just the way I wanted.
Nevertheless I tried to give the focus to the form and then to a particular control. I succeeded in finding the Excel window but failed to set the focus on the form, not to mention the control. In fact, I don't know how to check if I succeeded in setting the focus on the Excel window. I used this code in my attempt of whose syntax I'm not sure.
Public Const SWP_NOMOVE = &H2 ' ignore cx and cy
Public Const SWP_NOSIZE = &H1 ' ignore X and Y
SetWindowPos Wnd, HWND_TOP, 0, 0, 0, 0, (SWP_NOMOVE + SWP_NOSIZE)
Anyway, the form remains dimmed out. Does anyone have advice for me?
In order to obtain the form handler, you should proceed in this way:
Use API GetActiveWindow and create a Private variable on top of the form code module (in the declarations area):
Option Explicit
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private frmHwnd as LongPtr
Insert the next code line in the UserForm_Initialize event:
frmHwnd = GetActiveWindow
Related
So I've spent the evening trying to design snake in VBA. Great stuff. It seemed to be working fine whenever I ran the Main Sub from the VBA window (by clicking the play button in the top ribbon), however when I added a button on the worksheet for the same sub, it runs with no errors but the controls don't behave in the same way. Originally each time you press an arrow you just change direction, however when running the macro through a button you can keep holding the arrow in the direction you're going and it speeds up the snake, so the cell select behaves as it normally would in Excel, rather than as required in snake. This defeats the purpose of the game as the rest of the snake can't catch up with the head and creates gaps within allowing the user to just jump through it.
I'm using GetAsyncKeyState to read key presses:
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#End If
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
And then calling this with If Statements:
' Key press handling
WasteTime (speed)
If GetAsyncKeyState(VK_DOWN) Then
PressDown
ElseIf GetAsyncKeyState(VK_UP) Then
PressUp
ElseIf GetAsyncKeyState(VK_LEFT) Then
PressLeft
ElseIf GetAsyncKeyState(VK_RIGHT) Then
PressRight
End If
' Offset by key direction or default
ActiveCell.Offset(cellrow, cellcol).Select
For reference, this is all that each key function does:
Function PressUp()
cellrow = -1
cellcol = 0
End Function
Any help would be greatly appreciated. I suspect this has something to do with me declaring the GetAsyncKeyState function in the General Declarations section, but as I've never done this before, can't quite work out what I'm doing wrong. Thanks :)
I have an Excel form in which I use controls' mouse move event for simulating hovering effect.
There's no problem when the form is showed modal.
When I show the form modeless, even with the stationary mouse, the mousemove event of every control is continuously fired (if the mouse is over that control). The CPU usage grows up to 26-30%.
Nothing changes if the mouse move event has no code inside.
If I comment the entire events this strange behavior disappears.
It seems that the mere existence of the mouseMove event it's enough to create the problem.
I've searched a lot, but it seems I'm the only one having this problem.
I can share the workbook if anyone wants to see it.
I have a relatively simple solution that should handle the CPU usage problem, this doesn't do anything against the event triggering while the mouse is stationary though. The idea is to use the sleep function provided by the windows API to decrease the frequency of the events activation.
So first you need to get the function:
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
#End If
and then inside your userform:
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
sleep 1 '1 should be the time in milliseconds that the code will wait,
'in practice it waits 15ms (see edit below)
'insert the rest of your code here
End Sub
The sleep 1 will make the code wait for one millisecond before resuming execution. Edit: in practice it will make the code wait for 15 milliseconds, see #GSergs comment to this answer.
This is usually enough to get rid of the cpu usage problem. If you don't need the event to trigger 65 times a second you can change the triggering frequency by waiting longer, for example with sleep 30.
If you only need the event to activate once every time the mouse goes from "not over the control" to "over the control" a solution is to use an activation flag:
Inside the Userforms Module:
Dim ControlActive As Boolean
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not ControlActive Then
ControlActive = True
'insert the rest of your code here
End If
End Sub
Private Sub Userform_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ControlActive Then
ControlActive = False
End If
End Sub
VBA noob here.
I am developing a workbook which makes use of an external dll from my client.
In a sheet I have a button that, when pressed, starts a routine which makes a shape orange, then calls the API and finally makes the shape black.
Misteriously, it works only 'few times'.
The following code resides in a sub within a module:
Dim shapeToFlash As String
shapeToFlash = "SHAPE " & sheetName
Worksheets("GTE HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 53
Worksheets("HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 53
// API CALL (kind of long operation ~ 3/4 seconds)
Worksheets("GTE HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 0
Worksheets("HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 0
I cannot share details about the API. I simply declare with the traditional sintax:
#If Win64 Then
Private Declare PtrSafe Function IMB_set_value _
Lib "path/API.dll" () As Long
#Else
Private Declare Function IMB_set_value _
Lib "path/API.dll" () As Long
and works perfectly.
The problem is that the first SchemeColor (to 53) does not work meaning that the API is called and the second SchemeColor too (the shape turns black). Just to test, I tried to comment the second SchemeColor (to 0) and I noticed that in this case the shape turns orange AFTER the API is called! That suggested me Excel create a sort of priority queue of the commands to be executed and that the API call is performed before the first SchemeColor: that clearly messes with my flow. Is there a way to force Excel to execute immediately an operation? Is there another reason for the fail?
P.S.: I have executed the first SchemeColor lines of code separately and works nicely so I suppose the code is correct.
P.P.S.: I have also tried using RGB instead of SchemeColor, with the same result.
Try this
Sub InitiateLongRunningOperation()
Dim Argument as String
HighlightShape
Argument = "Argument Value"
Application.OnTime Now, "'LongRunningOperation """ & Argument & """'"
End Sub
Sub HighlightShape()
Worksheets(1).Shapes(1).Fill.ForeColor.SchemeColor = 53
End Sub
Sub LongRunningOperation(AnArgument As String)
Debug.Print AnArgument
' Replace the line below with your API call
Application.Wait Now + TimeValue("0:00:03")
Application.OnTime Now, "ResetShape"
End Sub
Sub ResetShape()
Worksheets(1).Shapes(1).Fill.ForeColor.SchemeColor = 0
End Sub
It works with Application.OnTime to start the chain of events without waiting for all of it to end before updating.
I have changed some of your code to make it easier to reproduce, but I think you will be able to follow it quite easy.
Well, the title is because I had a hard time walking through some unbearable docs and finding what I was looking for so, if these keywords can help for other google searches...
Then, when quitting Excel, all previously marked lines of code are lost and it is very frustrating when you have to go to sleep or Excel crashes :)
So, in a moment of pure madness I thought it could be possible, and even not too hard, to just save those line bookmarks and restore them at start up...
You will tell me there are other choices: don't sleep.. or use some powerful add-ins like MZ-Tools or Rubberduck, but I would like to have a native solution and understand what the problem is.
To cut to the edge, here is the core of my problem:
'sub to move cursor to a selected line and add a line bookmark:
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Application.VBE.VBProjects("VBAProject") _
.VBComponents(CompName).CodeModule.CodePane _
.SetSelection numLine, 1, numLine, 1
Application.VBE.CommandBars("Edit").Controls(18).Controls(1).Execute 'the only way I could find it to work
End Sub
What happens:
1) with only one call it works!
Public Sub test_addBmk()
Call AddBmkOnly("module 1", 10)
End Sub
2) once there are more, or in a loop for example:
Public Sub test_addBmk()
Call AddBmkOnly("module 1", 10) 'cursor is just moved to selected line
Call AddBmkOnly("module 2", 5) 'line bookmark is added only in the last opened/activated/selected/visible/shown/focused on..? codepane
'...
End Sub
Place your cursor inside the 2nd test_addBmk, run and you will see a beautiful cyan blue mark appearing in the margin of your "module 2" at line 5 but that's all, no where else.
I well tried to add this kind of lines in AddBmkOnly to keep focus/active state, but it has no effect:
With Application.VBE.VBProjects("VBAProject").VBComponents(CompName)
.Activate
.CodeModule.CodePane.Window.SetFocus
.CodeModule.VBE.ActiveCodePane.Show
'...?
end with
I tried adding some DoEvents, Debug.Print, loop to 1M or likes to see if it was due to some latency/refreshing effect, but no effect either.
It could have something to do with the active state of the module or codepane window, but I can't find a working combination (also, closing the last pane - .ActiveCodePane.Window.Close - will avoid a bookmark to be added too).
It seems also that the focus is lost before an anchor is added, whatever I try, or the 'add bookmark' menu action doesn't see where to apply.... or it is something else...
Calling test_addBmk() multiple times doesn't work neither, the only way I found is creating 'one action' buttons in an Excel sheet, as many as the number of bookmarks I needed... that's not funny.
What am I doing wrong? Is it even possible the way I'm trying? How can I add more than a single bookmark?
You need to active the code pane before you invoke the menu item:
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Dim editor As VBE
Dim project As VBProject
Dim component As VBComponent
Set editor = Application.VBE
Set project = Application.VBE.VBProjects("VBAProject")
Set component = project.VBComponents(CompName)
component.CodeModule.CodePane.SetSelection numLine, 1, numLine, 1
component.Activate
Application.VBE.CommandBars("Edit").Controls("&Toggle Bookmark").Execute 'the only way I could find it to work... almost[*]
End Sub
Note that this won't work if you try to step through it in a debugger, because each time you step it sets the active pane back to the code that you're executing.
A couple other notes:
You should be testing the number of code lines before trying to set the selection - if numLine is higher than the lines of code in the module, that's an application error.
Call should be considered deprecated - there's absolutely no reason to use it.
You should avoid hard coding an index in the Controls collection - other add-ins can modify these, so who knows what you'll get.
Thanks for mentioning Rubberduck! (I'm a contributor)
This version of the above works for me.
Public Sub test_addBmk()
Call AddBmkOnly("module1", 10)
Call AddBmkOnly("module2", 5)
End Sub
Public Sub AddBmkOnly(ByVal CompName As String, ByVal numLine As Long)
Dim editor As VBE
Dim project As VBProject
Dim component As VBComponent
Set editor = Application.VBE
Set project = Application.VBE.VBProjects("VBAProject")
Set component = project.VBComponents(CompName)
component.CodeModule.CodePane.SetSelection numLine, 1, numLine, 1
component.Activate: DoEvents
editor.CommandBars("Edit").Controls("&Toggle Bookmark").Execute
DoEvents
End Sub
Is it possible, without an insane amount of work, to customize to location of the FolderBrowserDialog when it appears? I was hoping for the ability to position it at the left upper corner of the main form of my application.
Hoping for something like this:
Private Sub but_OpenFolderBrowser_MoveTo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles but_OpenFolderBrowser_MoveTo.Click
'Set up the folder browser
'Set description
Me.folderBrowser.Description = "Select the directory:"
'Set starting location on screen
Me.folderBrowser.Location = Me.Location
Unfortunately I realized that this property is not available and probably not feasible.
Anyone have a solution?