This worked before I switched to Office 2016 it doesn't any more.
Does anyone have an alternative way to make a simple popup box that closes after x seconds? I don't need an OK-button or any user interaction, just a plain simple popup message.
Sub MessageBoxTimer()
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
AckTime = 3
Select Case InfoBox.Popup("Click OK (this window closes automatically after
3 seconds).", _
AckTime, "This is your Message Box", 0)
Case 1, -1
Exit Sub
End Select
End Sub
Related
I have an excel sheet that makes a custom toolbar. Within this toolbar, I have several buttons that use faceIDs, which are no problem. I have a few buttons where I wanted to use custom icons. When I use the custom icons, sometimes the PasteFace works, sometimes it does not, and I get an error. I added an On Error Resume next statement, to see what was happening. Sometimes both buttons paste ok, sometimes just one button, sometimes neither button. I can find no pattern to it working or not working.
My toolbar consists of approximately 24 buttons, and one drop down box. Eleven of the buttons use a custom icon, the remainder use a FaceID. Some buttons are toggled to display or not display based on user needs. The example below shows 2 buttons that will toggle to turn a meal penalty on or off. I only picked these 2 buttons because these are first buttons to use a custom icon.
Sub Make_PayBar()
Dim PayBar As CommandBar
Dim NewButton As CommandBarButton
'Delete existing PayBar toolbar if it exists
Call Kill_PayBar
ThisWorkbook.Activate
On Error Resume Next
'Create New PayBar
Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
PayBar.Visible = True
PayBar.Position = msoBarTop
... Missing Code, More buttons ...
'Meal Penalty Off Button
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
NewButton.Caption = "Meal Penalty Off"
NewButton.OnAction = "ToggleMeal"
'NewButton.FaceId = 1254 'Backup if pasteface fails
Sheets("Pics").Shapes("Meal_Off").Copy
NewButton.PasteFace
'Meal Penalty On Button
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_On")
NewButton.Caption = "Meal Penalty On"
NewButton.OnAction = "ToggleMeal"
'NewButton.FaceId = 1253 'Backup if pasteface fails
Sheets("Pics").Shapes("Meal_On").Copy
NewButton.PasteFace
NewButton.Visible = False
... Missing Code, More buttons ...
End sub
If the Resume Next is not used, the error may occurs on either of the two pasteface statements.
Is there something in my code making PastFace unreliable?
If PasteFace is inherently unreliable, is there a way to check for a successful paste, and repeat if it wasn't?
Is there a better way to do this?
Worksheets have hidden collections that hold pictures and ActiveX controls. The VBA also has a hidden Picture type. Pictures have a CopyPicture method that is more consistent then `Shape.Copy.
Press F2 to open the Object Browser, right click and choose Show Hidden Members
Function picMeal_Off() As Picture: Set picMeal_Off = ThisWorkbook.Worksheets("Pics").Pictures("Meal_Off"): End Function
Function picMeal_on() As Picture: Set picMeal_on = ThisWorkbook.Worksheets("Pics").Pictures("Meal_on"): End Function
Sub Make_PayBar()
Dim PayBar As CommandBar
Dim NewButton As CommandBarButton
Set PayBar = Application.CommandBars.Add(Name:="Payroll Bar", Temporary:=True)
PayBar.Visible = True
PayBar.Position = msoBarTop
Set NewButton = PayBar.Controls.Add(Type:=msoControlButton, Parameter:="Meal_Off")
NewButton.Caption = "Meal Penalty Off"
NewButton.OnAction = "ToggleMeal"
picMeal_Off.CopyPicture
NewButton.PasteFace
End Sub
I created functions to refer to the Pictures by using this macro:
Sub PrintPitureDefs(ws As Worksheet)
Const BaseCode As String = "Function picCodeName() As Picture:Set picCodeName = ThisWorkbook.Worksheets(""WorksheetName"").Pictures(""PictureName""):End Function"
Dim Code As String
Dim Img As Picture
For Each Img In ws.Pictures
Code = Replace(BaseCode, "WorksheetName", ws.Name)
Code = Replace(Code, "PictureName", Img.Name)
Code = Replace(Code, "CodeName", Replace(Img.Name, " ", "_"))
Debug.Print Code
Next
End Sub
I am very new to Stack Overflow & VBA so please pardon me for any mistakes in my question.
We are trying to download a table into a .txt file from the SAP GUI interface using scripting
Whenever we try to run the code we get the error "the control could not be found by id".
The button which we are trying to press
Things we tried:
We tried using Send keys but we are not very confident on it. It will be our last resort.
When we used FindAllByName with "shell" it clicks the "Export" button on the table below it
From what I can understand
The numbers (Italized or marked with ** in code) in the script keep changing. So we guess there is a clash between the stored script number in SAP and in the excel from which we are trying to run
The Table which we are trying to interact only appears when we load sum part numbers and hit "Go". It wont appear when we initially open the GUI.
Public Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Sub SA_Dump()
Dim App, Connection, session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Dim setFocus As Long
Set App = SapGuiAuto.GetScriptingEngine
Set Connection = App.Children(0)
Set session = Connection.Children(0)
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Dim sCestaGrid As String
Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Copy
setFocus = session.ActiveWindow.Handle
SetForegroundWindow setFocus
Application.Wait (Now + TimeValue("0:00:05"))
'Reset fields
session.findById("wnd[0]").resizeWorkingPane 147, 25, False
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1001/btnRESETSIMPLESEL").press
'hit selection window
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB02:/SCF/SG/CA_110SPPDRPSB1:1002/btnSGNT_0000034-MATNR_V").press
'hit copy from clipboard
session.findById("wnd[1]/tbar[0]/btn[24]").press
'hit Check entries mark
session.findById("wnd[1]/tbar[0]/btn[0]").press
'hit Copy button
session.findById("wnd[1]/tbar[0]/btn[8]").press
'hit Go button
session.findById("wnd[0]/usr/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1005/subSUB01:/SCF/SG/CA_110SPPDRPSB1:1001/btnBUTTON01").press
'Clear clipboard to avoid pop-up at end to close Excel sheets
Application.CutCopyMode = False
'hit export (ERROR HAPPENS HERE!!!)
session.findById("wnd[0]/usr/subSUB02:/SCF/SG/CA_110SPPDRPSB1:*2119*/subSUB03:/SCF/SG/CA_110SPPDRPSB1:*2141*/cntlCONTAINER_7/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/subSUB02:/SCF/SG/CA_110SPPDRPSB1:*2119*/subSUB03:/SCF/SG/CA_110SPPDRPSB1:*2141*/cntlCONTAINER_7/shellcont/shell").selectContextMenuItem "&PC"
'hit Tick button
session.findById("wnd[1]/tbar[0]/btn[0]").press
'For rename
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Rel_mvmnt.txt"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 10
'Hit replace button
session.findById("wnd[1]/tbar[0]/btn[11]").press
End Sub
I use this way and it works:
session.findById("wnd[0]/tbar[0]/okcd").text = "%pc"
Let me know if it worked for you.
I have been researching using
WScript.CreateObject("WScript.Shell")
to act as a means to create a multi-line, hover-over, 5-second pop-up for a command button on a Userform. From everything I can figure this should be working fine, but it's giving a "Variable not defined" error. On debugging it highlights "WScript" in the Set line as the issue.
Private Sub CB1604A_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Dim WshShell
Dim BTN
Set WshShell = WScript.CreateObject("WScript.Shell")
BTN = WshShell.PopUp("What do you want to do?", 5)
Select Case BTN
Case 6
WScript.Echo "Do it now."
Case 7
WScript.Echo "Do it later."
Case -1
WScript.Echo "Cancel all actions?"
End Select
End Sub
You would need to add a reference to WScript to use its CreateObject - but you don't need to; instead use VBA's CreateObject to create an instance of .Shell:
Set WshShell = CreateObject("WScript.Shell")
BTN = WshShell.PopUp("What do you want to do?", 5)
And subsequently use MsgBox instead of WScript.Echo:
...
MsgBox "Do it now."
I've got a macro excel that makes many things. One of those things is to run a query (via ADODB.Connection). The query can last a lot, so I would like:
Show a modal informative dialog, saying "running query 3" (for example), without any buttons (the user shouln't be able to close it). It should be blocking for the user, but non-bloking for the macro.
Run the query.
Close the informative window.
In pseudo-code:
dim cn as new ADODB.Connection
dim rs as new ADODB.Recordset
dim dia as InfoDialog
set dia = new InfoDialog "running query 3"
cn.Open cn_string
rs.Open query_string, cn, ...
dia.close
I would prefer a solution without having to import new libraries (vba editor > tools > references). For example, with something similar to 'CreateObject("WScript.Shell")'. If not possible, then library import is welcome too (preferablily standard libraries, for not having to install things in users' computers).
Update: Following Kenda's suggestion, I have made a userForm "InfoDialog" with a label "Label1", and created two library functions to make it easy to use:
sub show_info(text as string)
InfoDialog.Label1.Caption = text
InfoDialog.Show
DoEvents
end sub
sub close_info()
InfoDialog.Hide
end sub
So now I can write:
show_info "Connecting to db ..."
cn.Open cn_string
show_info "Running query ..."
rs.Open query_string, cn, ...
close_info
just insert UserForm with Label than in your code you can use
Form1.Show
Form1.Label1.Text="running query 3"
...
Form1.Hide
on the end optional unload form with Unload Form1
I've another problem with running macro. When I run large code, an Excel 2010 looks like it freeze, but macro still running on backround. And user haven't ProgressBar. So I use some trick with Label with blue BackColor in Frame. (Contains: Label named lblDescription, Fram named FrameProgress where is Label named LabelProgress)
For nonFreezing make this:
1) add Sub on Activate form
Private Sub UserForm_activate()
Call ImportDat
End Sub
2) in Module1 make starting Sub
Sub ShowDialog()
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub
3) in Module1 make your Sub with this code (magic word is DoEvents)
Sub ImportDat()
Dim Counter As Integer
Dim RowMax As Integer
Dim PctDone As Single
Application.ScreenUpdating = False
Counter = 1
RowMax = 10000
For i = 0 To RowMax -1
PctDone = i / RowMax
With UserForm1
.lblDescription = "Processing " + CStr(i + 1) + " from " + CStr(RowMax)
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
DoEvents
Next i
Application.ScreenUpdating = True
Unload UserForm1
End Sub
Hope it helps you.
I am writing a macro to download a csv file from my company's internal website.
For many reasons I can't use any xmlhttp objects. The macro will download the file. The problem is Internet Explorer 9 prompts the user with Open, Save, and Cancel buttons.
While in IE, Alt+Shift+S will save the download, but I can't get the Sendkeys "%+s" method from Excel VBA to work.
Here is the relevant code:
Function followLinkByText(thetext As String) As Boolean
'clicks the first link that has the specified text
Dim alink As Variant
'Loops through every anchor in HTML document until specified text is found
' then clicks the link
For Each alink In ie.document.Links
If alink.innerHTML = thetext Then
alink.Click
'waitForLoad
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "%+s", True
followLinkByText = True
Exit Function
End If
Next
End Function
Like I mentioned in my comments, The Info Security bar makes it difficult to interact with the File Download Window.
An alternative is to use the webbrowser control and then passing the URL to it. But the main problem with this method is that you cannot have the webbrowser in the same Excel Instance. Once the File Download window pops up your entire VBA Macro will come to a standstill till the time you do not dispose it off.
Here is an alternative. Here is a small exe that I created in VB6 which will pop up the File Download window bypassing the IE Info Security Bar. And once the File Download window pops up, you can interact with it using the APIs as shown in my blog article.
Let's take an example to see on how we interact with this vb6 exe file.
Create a module in Excel and paste this code.
IMPORTANT NOTE: Since you didn't give me any URL, I am taking a Static URL. Please replace it with your link. Now depending upon the link that you specify, you might see the one of these two download windows. Based on the download window that you see you will have to find the window handles based on the pic shown below. More details on the blog link that I gave.
Download the file attached and save it in say C:\. If you save it in any other location then amend that in the Shell statement below.
Sub Sample()
Dim sUrl As String
sUrl = "http://spreadsheetpage.com/downloads/xl/king-james-bible.xlsm"
Shell "C:\FDL.exe " & sUrl, vbNormalFocus
End Sub
SNAPSHOT
FILE: The file can be downloaded here.
You may try this as it is worked for me on IE 11:
Copy file C:\Windows\System32\UIAutomationCore.dll file to users Documents i.e C:\Users\admin\Documents then add reference UIAutomationClient to your macro file.
Paste below code in your module:
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
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
Sub Download()
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
Try at your end.
I think I came up with a simpler solution: when the download bar appears in IE9, just by-pass it by displaying the "real" Download Pop Up window. The shortcut is "CTRL+J". All you have to do next is click on "Save" or "Open". There might be pretty ways to do it, but I simply send a key sequence to move the focus on desired option and then press enter.
Here is the code:
' Wait for download bar to appear
Application.Wait (Now + TimeValue("0:00:04"))
' Sending CTRL+J to open download pop-up
SendKeys "^j"
' Wait for download popup to appear
Application.Wait (Now + TimeValue("0:00:02"))
' Sending keys sequence to click on "Save" button
SendKeys "{RIGHT}{RIGHT}{RIGHT}~"
Your Application.Sendkeys just needs a tweak. Below is the code I am using so it is tested on IE11. This is for Alt+S with no Shift which is the keyboard shortcut in IE11. Let me know if this doesn't work and you need help adding the Shift back in.
Application.SendKeys "%{S}", True