My Excel application requires a pop-up screen while it is loading and saving files. I have created a macro, shown below to pop-up a shape. Initially, the oShape.Top location is 300, below the current screen.
I have tried all combinations of the macro & cannot get this oval shape to be visible on the current screen. Oddly, if I create a debug-toggle breakpoint on the last "DoEvents" in this macro, the pop-up will be visible.
Any assistance would be appreciated. Macro is below:
Public Sub TestUP()
Dim oShape As Shape
Set oShape = ActiveSheet.Shape("Oal42")
Application.ScreenUpdating = True
DoEvents
NextTime = Now + TimeValue("00:00:05")
oShape.Visible = True
oShape.Top = 80
DoEvents
NextTime = Now + TimeValue("00"00"05")
DoEvents
End Sub
Your main problem is that a shape is not repainted in the moment you show it, and it seems it is even not repainted when you issue a DoEvent. For a UserForm, there is a Repaint method to force VBA to re-show it, but not for a sheet or a shape.
However, there are tricks to do so. This answer shows 3 possible hacks. I tried Application.WindowState = Application.WindowState and it worked for me. The following code gives an example how you could use it - you can modify the text during runtime.
Option Explicit
Const ShapeName = "Oal42"
Public Sub ShowMsg(msg As String)
With ActiveSheet.Shapes(ShapeName)
If .TextFrame2.TextRange.Characters <> msg Then
.TextFrame2.TextRange.Delete
.TextFrame2.TextRange.Characters = msg
End If
.Visible = True
.Top = 80
DoEvents
Application.WindowState = Application.WindowState
End With
End Sub
Public Sub HideMsg()
ActiveSheet.Shapes(ShapeName).Visible = False
End Sub
This shows the usage:
Sub testSub()
ShowMsg "Start"
Dim i As Long
For i = 1 To 100 Step 8
ShowMsg "Working, " & i & "% done."
Application.Wait Now + TimeSerial(0, 0, 1)
Next i
HideMsg
End Sub
Related
I am trying to create an excel addin which has a button when clicked will display a VBA form. Its quite simple one list box and one command button.
Below is the code in Command button
Private Sub CommandButton1_Click()
ThisWorkbook.IsAddin = False
On Error GoTo ErrHandler:
KeyAcc = WorksheetFunction.VLookup(ComboBox1.Value, Sheet1.Range("A:B"), 2, False)
MsgBox KeyAcc
ThisWorkbook.IsAddin = True
Unload Me
Exit Sub
ErrHandler:
MsgBox ComboBox1.Value & " Not found in the Database"
ThisWorkbook.IsAddin = True
Unload Me
ActiveWorkbook.Save = False
End Sub
Code in form load
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Dim cCount As Integer
ThisWorkbook.IsAddin = False
ThisWorkbook.Sheets("Sheet1").Select
For cCount = 1 To 320
UserForm1.ComboBox1.AddItem Range("A" & cCount).Value
Next
ThisWorkbook.IsAddin = True
ComboBox1.SetFocus
End Sub
The problem i face is whenever the user activates this button on the first book ie, after opening a new excel and performs the operation it works, once done when i try to close the blank workbook it asks do you want to Save your changes to the Addin
Is there any way to avoid this?
You don't need all that work just to load your combobox:
Private Sub UserForm_Activate()
Me.ComboBox1.List = ThisWorkbook.Sheets("Sheet1").Range("A1:A320").Value
ComboBox1.SetFocus
End Sub
There are a lot of tutorials in the Internet. However I was not able to find anything suitable. Is there any way to make animated dots on loading?
The idea is to make a loop of animated dots ..... on userform so they would appear one after another and then would start over after some amount of dots.
So I input a dot to Label1 and move it to left after certain time criteria?
My current code for UserForm:
Private Sub UserForm_Initialize()
HideTitleBar.HideTitleBar Me
Call loadingdots
End Sub
Code for Private Sub Workbook_Open():
Loading.Show (vbModeless)
Dim RngCom As Range
Dim RngTurb As Range
Dim RngGen As Range
Application.Wait (Now + TimeValue("00:00:06"))
ThisWorkbook.Worksheets("MAIN").ScrollArea = "$A$1:$BL$45"
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
etc...
Unload Loading
'Application.ScreenUpdating = True
End Sub
The most elegant solution would likely to be the OnTime method.
Place a label inside your UF and remove the caption. Next, in a regular module (so not that of the UF), place this subroutine:
'this function ensures the self-activating sub will stop if the UF has been closed
Public Function IsLoaded(form As String) As Boolean
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = form Then
IsLoaded = True
Exit Function
End If
Next frm
IsLoaded = False
End Function
Public Sub loadingdots()
If IsLoaded("UserForm1") = True Then
If Len(UserForm1.Label1.Caption = 4) Then
UserForm1.Label1.Caption = "."
Else
UserForm1.Label1.Caption = UserForm1.Label1.Caption & "."
End If
Application.OnTime Now + TimeValue("00:00:01"), "loadingdots"
End If
End Sub
Next, call the self-activating sub when the UF gets initialised
Private Sub UserForm_Initialize()
Call loadingdots
End Sub
Do not forget to change the references to the UF to the right name.
I am trying to open a userform through a custom excel ribbon. When I click the button in the ribbon it begins initializing and on the workbooks.open function it sends the code to the queryclose sub. The show userform code is below:
Sub RemoveFixture_onAction(control As IRibbonControl)
SelectedCompType = Fixture
Set EditComp = New ufUpdateComp
With EditComp
.Top = Application.Top + 125
.Left = Application.Left + 25
.Show
End With
End Sub
When the code begins the userform_Initialize code it ends up moving to the query_close sub. The code for that is below:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'If wb Is Nothing Then UserForm_Initialize
wb.Close False
End Sub
As seen above, in the commented out section, I tried to return to the initialize sub when the code moved to the queryclose function. It moves to the queryclose sub when it runs the workbooks.open code and it says that the wb is nothing. I have tried opening the workbook separately and then setting the workbook as ActiveWorkbook. I also tried:
do while wb is nothing
set wb = ActiveWorkbook
loop
This loop ran endlessly until I had to manually cancel it.
It was originally set wb = workbooks.open(Test)
Private Sub UserForm_Initialize()
Workbooks.Open Test, , , , , DynoCompPassword, True
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Info")
Set ws = wb.Worksheets("Info")
Set wsC = wb.Worksheets("Calipers")
Set wsF = wb.Worksheets("Fixtures")
Set wsW = wb.Worksheets("Wheel Sims")
ws.Visible = True
wsC.Visible = True
wsF.Visible = True
btnCreate.Enabled = False
Dim rng As Range
lblLocation.Visible = False
tbLocation.Visible = False
Me.cbOut.AddItem "Sent To"
Me.cbOut.AddItem "Scrapped"
Me.cbOut.AddItem "Returned"
Me.btnCreate.Enabled = True
For Each rngprojectcode In ws.Range("ProjectCode")
Me.cbProjectCode.AddItem rngprojectcode.Value
Next rngprojectcode
Set ProjCodeDictionary = New Dictionary 'Create the dictionary
Dim i As Integer
Dim j As Integer
Dim ProjCodeString As String
Dim AssociatedCodes As ProjectCodeList
If ws Is Nothing Then Exit Sub
ProjCodeDictionary.CompareMode = vbTextCompare 'Make the .exists method case insensitive in an attempt to avoid duplicate values
Set AssociatedCodes = New ProjectCodeList 'create the class module which will split up the associated codes into individual values
i = 1
While ws.Range("F1").Offset(i, 0) <> ""
With AssociatedCodes
.SetCodes = CStr(ws.Range("F1").Offset(i, 0).Value)
For j = 1 To .NumCodes
ProjCodeDictionary.Add .ProjCode(j), i 'key, item
Next j
End With
i = i + 1
Wend
If SelectedCompType = Fixture Then
Me.lblCompNum.Caption = "Fixture ID"
Me.btnCreate.Caption = "Update Fixture"
'Automation Error occurs here
Me.Caption = "Edit Fixture"
Me.frChangeFrame.Height = 65
Me.frChangeFrame.Caption = "Bolt Circle"
Me.cbPartNum.Text = "FIX"
For Each rng In wsF.Range("FixtureNum")
Me.cbPartNum.AddItem rng.Value
Next rng
Set tbNumStuds = frChangeFrame.Controls.Add("Forms.TextBox.1", , "True")
To clarify, the queryclose sub should only be activated when the red box with the X is pressed in the userform. It is a built in function of the userform.
The only time the queryclose sub should run is when the X button is pressed on the userform.
But that's not how QueryClose works. The UserForm.QueryClose event is fired whenever the form is about to be closed, and its parameters give you means to cancel it, depending on what prompted it to close.
What you want is to run wb.Close False conditionally, when the CloseMode parameter value is vbFormControlMenu (the X button - see QueryClose constants):
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
wb.Close False
End If
End Sub
I tried to return to the initialize sub when the code [...]
Don't do this. Event handlers are meant to be invoked by VBA itself, not user code. If you need to invoke logic that you've implemented in an event handler, refactor the code out of the handler and into its own procedure instead:
Private Sub UserForm_Initialize()
DoInitializationStuff
End Sub
Private Sub DoInitializationStuff()
'...
End Sub
Lastly, the UserForm.Initialize event is fired well before the form is shown.
Set EditComp = New ufUpdateComp ' <~ initialize handler runs before this instruction returns
With EditComp
.Top = Application.Top + 125
.Left = Application.Left + 25
.Show
End With
Note that you don't need to declare the local variable if you're only using it in a With block - have the block hold the object reference instead:
With New ufUpdateComp ' <~ initialize handler runs before this instruction returns
.Top = Application.Top + 125
.Left = Application.Left + 25
.Show
End With
If you want DoInitializationStuff to run after the form is shown, invoke it in the Activate event.
Found some tips here and in google, but can't implement properly.
Say I have a loop that runs, and I need to show a box with a button "Cancel".
The code must run till I press the button.
In the following example I used For Loop and show iteration number in the Label1.Caption
' action of UserForm1 on Button Click
Private Sub CommandButton1_Click()
cancel = True
End Sub
Public cancel as boolean
Sub example ()
cancel = False
Dim i As Integer
For i = 1 To 1000
Application.Wait (Now + #12:00:01 AM#)
UserForm1.Label1.Caption = CStr(i)
UserForm1.Show vbModeless
If cancel = True Then
Exit For
End If
Next i
End Sub
This code runs, but it doesn't react on Button click.
If I do UserForm1.Show vbModal, then the code stops and waits till I click the button.
What am I doin wrong?
This is my code and it works perfectly when the userform is opened with frmTest.Show false
Dim cancelbool As Boolean
Function loopfunction()
Dim i As Integer
i = 0
Do Until cancelbool
DoEvents
Me.lblIteration.Caption = i
i = i + 1
Loop
End Function
Private Sub cmdCancel_Click()
cancelbool = True
End Sub
Private Sub UserForm_Activate()
loopfunction
End Sub
And by the way, the Application.Wait makes your app unresponsive
Help!
Below is my code for a start/stop button in Excel and now I'm getting a Compile error that is highlighting btnStart on the first line.
Sub btnStart()
ActiveSheet.Unprotect
Cells(Rows.Count, 5).End(xlUp).Offset(1) = Date
Cells(Rows.Count, 6).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
Cells(Rows.Count, 8).End(xlUp).Offset(1) = Environ("username")
Me.btnStart().Enabled = False
Me.btnStop.Enabled = True
End Sub
Sub btnStop()
ActiveSheet.Unprotect
Cells(Rows.Count, 7).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
Me.btnStart.Enabled = True
Me.btnStop.Enabled = False
End Sub
Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
If I understand correctly the buttons are on an excel sheet (not in a user form) so your issue because you are calling the buttons incorrectly. you can't simply call the named buttons you must look into the sheet.buttons property like this
ActiveSheet.Buttons("btnStart").
Also if you have named sheets I would use the sheetname rather than ActiveSheet
Sheets("sheetname").Buttons("btnStart").
One more note, that enabling/disabling a button works BUT it doesn't make the button appear enabled/disabled. To do this you also have to change the font color.
ActiveSheet.Buttons("btnStart").Font.ColorIndex = 15 '15 is grey, 1 is black
---- edit: code changed ---
REASON: After doing some more research it seems there are problems with my original solution. The most important is that the "enabled" property has no effect in excel 2010. Another route would be using activeX controls, BUT, a recent windows update (dec 2014) prevents activeX controls from running without deleting some system files (which would have to be done for each user, on every computer this code may run on -_- good job MS SOURCE)
This new solution should avoid all those problems. It uses two global variables start_btn_disabled and stop_btn_disabled I assume each button in your form (btnStart and btnStop) have a macro assigned to them? Simply check the global variable at the very beginning of the the sub if the button is disabled then quit the sub, so even though the click is still processed (it will always be processed in excel 2010 as stated before) the code doesn't run. So it behaves as though it was disabled. In my code I made a sub called btnStopClicked that would run when you click 'btnStop' In order to assign the macro to a button, right click the button, select "assign macro" and select the appropriate macro. I also created a similar sub for when you click the start button
'these are global variables and should be declared at the top of the module
'outside of any sub/function
'
'Note we use DISabled rather than enabled, because by default
'booleans = False. This means as soon as the form opens both these buttons
'will be enabled without any extra work.
'If you want to change this (make start button enabled and stop disabled,
'when the workbook opens simply change all the "stop_btn_disabled" to
'"stop_btn_enabled" and uncomment the following line) make sure you change the
'variable names so they make sense
'Dim stop_btn_enabled As Boolean 'initializes to false
Dim start_btn_disabled As Boolean 'intializes to false
Dim stop_btn_disabled As Boolean 'intializes to false
'Most of this code remains the same as before
Sub btnStart()
ActiveSheet.Unprotect
Cells(Rows.Count, 5).End(xlUp).Offset(1) = Date
Cells(Rows.Count, 6).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
Cells(Rows.Count, 8).End(xlUp).Offset(1) = Environ("username")
'now we set the state of the global variable
start_btn_disabled = True
'makes the button appear greyed out
ActiveSheet.Buttons("btnStart").Font.ColorIndex = 15
'now we set the state of the global variable
stop_btn_disabled = False
'makes the button black like normal
ActiveSheet.Buttons("btnStop").Font.ColorIndex = 1
End Sub
Sub btnStop()
ActiveSheet.Unprotect
Cells(Rows.Count, 7).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
'now we set the state of the global variable
stop_btn_disabled = True
'makes the button appear greyed out
ActiveSheet.Buttons("btnStop").Font.ColorIndex = 15
'now we set the state of the global variable
start_btn_disabled = False
'makes the button black like normal
ActiveSheet.Buttons("btnStart").Font.ColorIndex = 1
End Sub
'and now the real key is checking the globals before running the code
'when you click "btnStop" button this is the code that runs, you may have
'named the sub something different, I just named it this way so it's clear
'what the sub does
Sub StopBtnClicked()
'must be the first bit of code in the btn click sub
If (stop_btn_disabled) Then
Exit Sub
End If
'the rest of the code when you click stop button goes here
'the only way to get to this point is if the but is enabled
End Sub
Sub StartBtnClicked()
'must be the first bit of code in the btn click sub
If (start_btn_disabled) Then
Exit Sub
End If
'the rest of the code when you click start
End Sub
if this solves your problem, please mark it as the answer
Maybe try the following, I corrected one line
Sub btnStart()
ActiveSheet.Unprotect
Cells(Rows.Count, 5).End(xlUp).Offset(1) = Date
Cells(Rows.Count, 6).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
Cells(Rows.Count, 8).End(xlUp).Offset(1) = Environ("username")
'Corrected line below
Me.btnStart.Enabled = False
Me.btnStop.Enabled = True
End Sub
Sub btnStop()
ActiveSheet.Unprotect
Cells(Rows.Count, 7).End(xlUp).Offset(1) = Now
Cells(Rows.Count, 7).End(xlUp).NumberFormat = "hh:mm"
Me.btnStart.Enabled = True
Me.btnStop.Enabled = False
End Sub
Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
You need to use ActiveX buttons if you want to use the Enabled property:
Private Sub btnStart_Click()
Me.btnStart.Enabled = False
Me.btnStop.Enabled = True
End Sub
Private Sub btnStop_Click()
Me.btnStart.Enabled = True
Me.btnStop.Enabled = False
End Sub