strong textI have a simple word form that I want to print. I pass the printer name to a sub routine (myprint) in the variable oprinter. The variable printcomplete will pass back the name of the printer that was successful in printing the data.
This logic works when I am in debug mode but appears to bypass the print commands when not in debug. I have tried adding delays, I have added a MSGBOX after the print statement (prior to
printcomplete = oprinter > Exit Sub). The MSGBOX does display - so it should have executed the print statement. I do not get the msgbox under myprinterr.
Any idea why it won't print out of debug mode?
Here is my code:
'Print MS Word Form to one of three networked printers
Sub MyPrint(oprinter, printcomplete)
Dim sPrinter As String
On Error GoTo myprinterr
Sleep (5000)
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = oprinter
.DoNotSetAsSysDefault = True
.Execute
Sleep (5000)
Application.PrintOut FileName:=""
.Printer = sPrinter
.Execute
End With
Sleep (5000)
MSGBOX "Did it print? "
printcomplete = oprinter
Exit Sub
myprinterr:
MsgBox "oops printer error on: " & oprinter
End Sub
In the code I've noticed several lines of code:
CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:05")) 'delay to try to get print to work when not in debug mode
There is no need to create a new Excel Application instance each time.
If you want to introduce any delay you can use the Sleep Windows API function instead. It suspends the execution of the current thread until the time-out interval elapses.
My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.
What can I do to force a screen update?
For i=1 to imax ' imax is usually 30 or so
fractionDone=cdbl(i)/cdbl(imax)
Application.StatusBar = Format(fractionDone, "0%") & "done..."
' or, alternatively:
' statusRange.value = Format(fractionDone, "0%") & "done..."
' Some code.......
Next i
I'm using Excel 2003.
Add a DoEvents function inside the loop, see below.
You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 10000
Application.ScreenUpdating = False
''//Turn off screen updating
booStatusBarState = Application.DisplayStatusBar
''//Get the statusbar display setting
Application.DisplayStatusBar = True
''//Make sure that the statusbar is visible
For i = 1 To iMax ''// imax is usually 30 or so
fractionDone = CDbl(i) / CDbl(iMax)
Application.StatusBar = Format(fractionDone, "0%") & " done..."
''// or, alternatively:
''// statusRange.value = Format(fractionDone, "0%") & " done..."
''// Some code.......
DoEvents
''//Yield Control
Next i
Application.DisplayStatusBar = booStatusBarState
''//Reset Status bar display setting
Application.StatusBar = False
''//Return control of the Status bar to Excel
Application.ScreenUpdating = True
''//Turn on screen updating
End Sub
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
This worked for me:
ActiveWindow.SmallScroll down:=0
or more simply:
ActiveWindow.SmallScroll 0
I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful.
Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 1
Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
Case 1, -1
End Select
I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True
In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.
This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.
None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit
Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.
I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with
doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.
I took out the Wait and reset ScreenUpdating and EnableEvents back to true.
This works office excel 2002 through to office 365
Sub Sheet1Mess(Mess1 As String)
Sheet1.Range("A6").Value = Mess1
ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
' Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I will try to be as clear as possible in the description, so here goes nothing:
I have created a code in which the user selects his excel file and then the macro copies the Sheet from that file into my macro Workbook.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
ActiveSheet.Copy After:=wbook.Sheets(1)
ActiveSheet.Name = "Selected file"
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
This is working, but what I realized is, that there might be cases where the selected file has multiple Sheets.
Is there a way to write the macro in which if my selected file has 1 sheet it runs the above code and if it has more than one sheet to let me select the sheet I want and then run the rest of the code?
Edit:
I thought of another way to handle this — perhaps closer to what you were looking for . . .
It's just an expansion of the basic pause routine that I use occasionally.
This is my "regular" Pause routine (using the Timer function):
Sub Pause(seconds As Single)
Dim startTime As Single
startTime = Timer 'get current timer count
Do
DoEvents 'let Windows "catch up"
Loop Until Timer > startTime + seconds 'repeat until time's up
End Sub
...so, it gave me an idea.
Honestly, I was a little surprised to discover that this works, since it's basically running two sections of code simultaneously.
Code for WaitForUserActivity :
Here's the code I used in the demo above:
Option Explicit
Public isPaused As Boolean
Sub WaitForUserActivity() 'THE 'RUN DEMO' BUTTON runs this sub.
Dim origSheet As String
isPaused = True 'flag "pause mode" as "on"
origSheet = ActiveSheet.Name 'remember current worksheet name
MsgBox "This will 'pause' code execution until you" & vbLf & _
"click the 'Continue' button, or select a different a worksheet."
Application.StatusBar = "PAUSED: Click ""Continue"", or select a worksheet."
Do 'wait for button click or ws change
DoEvents 'yield execution so that the OS can process other events
Loop Until (Not isPaused) Or (ActiveSheet.Name <> origSheet)
If isPaused Then 'the active worksheet was changed
MsgBox "Worksheet '" & ActiveSheet.Name & "' was selected." _
& vbLf & vbLf & "Now the program can continue..."
Else 'the button was clicked
MsgBox "The 'Continue' button was clicked." _
& vbLf & vbLf & "Now the program can continue..."
End If
Application.StatusBar = "Ready"
End Sub
Sub btnContinue() 'THE 'CONTINUE' BUTTON runs this sub.
isPaused = False 'flag "pause mode" as "off"
End Sub
To run the demo:
place the above code in a regular module
make sure the workbook has at least two worksheets
create two command buttons:
one for the "Run Demo" button, assign macro: WaitForUserActivity
one for the "Continue" button, assign macro: btnContinue
click the "Run Demo" button
The key command in the code is the DoEvents Function, which "yields execution so that the operating system can process other events."
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component - and the operating system takes care of multitasking and time slicing.
Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Further details (and warnings) at the source.
Original Answer:
Some suggested solutions:
Instead of "stopping" the code you could prompt the user to specify which worksheet.
The easiest way would be with an InputBox where the user would enter an ID number or otherwise identify the worksheet.
More complicated but more robust and professional-looking would be a custom dialog box with the help of a userform. There are several examples and tutorials online such as this one.
You could "pause" execution to give the user a set amount of time to select a worksheet, with a simple timer loop, ad you could even check the worksheet name to see if the user picked a new one, something like this:
Dim startTime As Single, shtName As String
If ThisWorkbook.Worksheets.Count = 1 Then
MsgBox "There is only one worksheet in this workbook."
Else
shtName = ActiveSheet.Name 'get name of active sheet
MsgBox "You have 5 seconds to select a worksheet after clicking OK.", _
vbOKOnly + vbInformation, "Select a worksheet... fast!"
startTime = Timer
Do
DoEvents
Loop Until Timer > startTime + 5
'check if user picked a new worksheet
If ActiveSheet.Name = shtName Then
MsgBox "You didn't select a new worksheet!"
Else
MsgBox "Thanks for selecting a new worksheet!"
End If
End If
It's a little hoakey but could work, especially if proper checks to make sure you've got the correct worksheet now.
I suppose you could create an worksheet event procedure that would run when a worksheet is activated, and checked a global variable to see if your "import procedure" was running, and if so, resume your code... but that would be messy and confusing and would require the code to exist in the workbook you're "importing".
Or, better than any of those would be to programmatically/logically determine which worksheet you need based on the contents of the worksheet. Is there a title? A certain date? Maybe the newest worksheet? Something in a certain cell? There must be something that differentiates it from the others.
Hopefully this gives you some ideas towards a non-linear solution. 😉
As in whole, I would recommend ashleedawg's solution, but if you
insisted on maintaining your code structure, your code could look
something like this:
You can distinguish between amount of Sheets a Workbook has using .Count property of the Sheets object (or Worksheets if you do not want to include Charts) and use InputBox to check for the sheet you want to look for.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
If ThisWorkbook.Sheets.Count = 1 Then
ThisWorkbook.ActiveSheet.Copy After:=wbook.Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Selected File"
Else
Dim checkfor As String
checkfor = InputBox("What Sheet should I execute the code for?")
Dim i As Integer
For i = 0 To ThisWorkbook.Sheets.Count
If Trim(LCase(checkfor)) = Trim(LCase(Sheets(i).Name))) Then
ThisWorkbook.Sheets(i).Copy After := wbook.Sheets(1)
ThisWorkbook.Sheets(i).Name = "Selected file"
End If
Next i
End If
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
Might need some further tweaking, because I was unsure what exactly you wanted to achieve.
I have some activex ListBox controls on my worksheet. I have applied a macro that opens the litsbox on double_click on any cell.
The issue is that in excel versions 2010 or less, I am unable to select any item from he listbox as the mouse cursor gets stuck in plus sign.
If I zoom in/out the sheet, the issue works for sometime then again gets back to same plus icon state.
This is issue does not occur in excel version above 2010.
Edit:
Code snippet:
`Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim colName, strRange As String
strRange = Target.Address
colName = Replace(Target(1).Address(0, 0), Target(1).row, "")
strRange = colName & CStr(1) & ":" & colName & CStr(6)
If ctrl Is Nothing Then
GoTo ExecuteSub
End If
On Error GoTo ExitSub
listBoxName = "ListBox" + CStr(Target.Column)
On Error GoTo ExitSub
Set ctrl = ActiveSheet.OLEObjects(listBoxName)
If ctrl Is Nothing Then
GoTo ExitSub
Else
Cancel = True
ctrl.Enabled = True
ctrl.Top = Target.Top + Target.Height
ctrl.Left = Target.Left
ctrl.Visible =True`
After some looking around into forums and support questions, I came up with a probable reason why this is happening.
It seems like excel and activex objects don't go well together. Whenever an excel file is zoomed in/out or opened on a screen resolution that was different from its original resolution, excel errors out in its size calculations for various activex objects. Thus, there is temporary distortion with these objects that renders the mouse icon as a plus icon.(unable to select any item). So, the solution will be to resize or reset any size parameter of the activex object(width,height) or by scrolling the active window like a refresh action.
ActiveWindow.SmallScroll ToLeft:=1
ActiveWindow.SmallScroll ToRight:=1
I would like to automate the process of protecting a word document for comments only using Office 2007 VBA's Document.Protect. This works fine if the document has no protection yet, but fails once the protection has ever been set before.
The following is a minimal working example that shows the bug I am facing (see below). I have reproduced on another PC running Office 2007 SP3. The problem occurs even with a blank document.
To reproduce, use the following macro after saving a new blank document:
Sub ProtectionBugOffice2007()
' Apply a first type of locking to simulate an existing lock
RecentFiles(1).Open
If ActiveDocument.ProtectionType <> wdNoProtection Then ActiveDocument.Unprotect
ActiveDocument.Protect wdAllowOnlyFormFields
ActiveDocument.Close (wdSaveChanges)
' Now do the real test: Lock with our intended protection type
RecentFiles(1).Open
ActiveDocument.Unprotect
ActiveDocument.Protect wdAllowOnlyComments
ActiveDocument.Close (wdSaveChanges)
' Validate!
RecentFiles(1).Open
If ActiveDocument.ProtectionType = wdAllowOnlyComments Then
MsgBox "Success!"
Else
MsgBox "Failure! Should be " & wdAllowOnlyComments & " but is " & ActiveDocument.ProtectionType
End If
ActiveDocument.Close
End Sub
Things investigated before:
Office 2007 is up to date with SP 3 and latest windows update
If performed manually protection type can be changed correctly, but recorded as macro fails.
Other types of saving the document (Document.Save or Document.SaveAs(2))
Disabling ReadingLayout ActiveWindow.View.ReadingLayout = False (see Alredo's answer): No change in Office 2007
Edits:
2015-10-23: Initial problem
2015-10-25: Minimal working example added.
2015-10-25: Discovered that only after manually or programmatically setting the protection type it can no longer be changed.
2015-10-26: Offered bounty
After doing some research online and the code failing on me several times. I found a post that solved my problem which was caused because word opens secured documents in reading view.
This is a link to the original post Link to post
Sub ProtectionBugOffice2007()
Dim oDoc As Document
' Apply a first type of locking to simulate an existing lock
Set oDoc = OpenRecentNotReadOnly
If oDoc.ProtectionType <> wdNoProtection Then oDoc.Unprotect
oDoc.Protect wdAllowOnlyFormFields
oDoc.Close (wdSaveChanges)
' Now do the real test: Lock with our intended protection type
Set oDoc = OpenRecentNotReadOnly
oDoc.Unprotect
oDoc.Protect wdAllowOnlyComments
oDoc.Close (wdSaveChanges)
' Validate!
Set oDoc = OpenRecentNotReadOnly
If oDoc.ProtectionType = wdAllowOnlyComments Then
MsgBox "Success!"
Else
MsgBox "Failure! Should be " & wdAllowOnlyComments & " but is " & oDoc.ProtectionType
End If
oDoc.Close
End Sub
' Function to open the document not in read only.
Function OpenRecentNotReadOnly() As Document
Dim ret As Document
Set ret = RecentFiles(1).Open
ActiveWindow.View.ReadingLayout = False
'Return the value
Set OpenRecentNotReadOnly = ret
End Function
I hope this helps :)