I have an excel macro that is launched by clicking a button.
What macro should do is print out one excel worksheet and increment value in one cell after each print.
Everything works fine EXCEPT the macro ALSO PRINTS the sheet where macro is launched (eventhough that sheet is not selected in code..)
Here is my macro code:
Sub Painike_Napsauta()
Dim i As Long
If MsgBox("Tulosta?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogPrint).Show
Sheets("Lappu").Range("C1").Value = Sheets("Tulosta").Range("C2").Value
For i = Sheets("Tulosta").Range("C3").Value To Sheets("Tulosta").Range("C4").Value
Sheets("Lappu").Range("C2").Value = i
Sheets("Lappu").PrintOut
Next i
Application.EnableEvents = True
End Sub
So all I want to print is "Lappu" sheet in every iteration, but for some reason also "Tulosta" sheet is printed and it is the first page that is printed.
Where is the problem?
Here is the workaround kind of solution to my problem:
Sub Painike_Napsauta()
Dim i As Long
If MsgBox("Tulosta?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Cancel = True
Application.EnableEvents = False
Sheets("Lappu").Range("C1").Value = Sheets("Tulosta").Range("C2").Value
Sheets("Lappu").Range("C2").Value = Sheets("Tulosta").Range("C3").Value
Sheets("Lappu").Activate
Application.Dialogs(xlDialogPrint).Show
For i = Sheets("Lappu").Range("C2").Value To Sheets("Tulosta").Range("C4").Value - 1
Sheets("Lappu").Range("C2").Value = i + 1
ActiveSheet.PrintOut
Next i
Application.EnableEvents = True
End Sub
So I first select "Lappu" sheet the active one with .Activate and then printout the active sheet with ActiveSheet.PrintOut
Related
I am trying to secure my workbook, i have multiple sheets that i need to hide and leave only one sheet to be displayed that will have a command button (Picture 1) when I click on it I have a userform that pops up (Picture 2) with username and password to open specific sheets( ive set different usernames and passwords to open specific sheet)
enter image description here
enter image description here
I wrote this code :
Private Sub CommandButton1_Click()
Dim User, Pass As String
User = Me.TextBox1.Text
Pass = Me.TextBox2.Text
If User = "Admin" And Pass = "123" Then
MsgBox ("Bienvenu")
Application.Visible = True
ActiveWorkbook.Unprotect Password:="password"
Sheets("ACCEUIL").Visible = True
Sheets("Liste Personnes").Visible = True
Sheets("Liste IT").Visible = True
Sheets("Liste PE").Visible = True
Sheets("Liste EM").Visible = True
Sheets("Liste ELC").Visible = True
Sheets("Liste Habilitation").Visible = True
Sheets("Liste EPC").Visible = True
Sheets("Liste ECH").Visible = True
ActiveWorkbook.Protect Password:="password"
Unload Me
Else
'Pole Essais
If User = "Admin1" And Pass = "456" Then
MsgBox " Bienvenue"
Application.Visible = True
ActiveWorkbook.Unprotect Password:="password"
Sheets("Liste Personnes").Visible = True
Sheets("Liste IT").Visible = True
Sheets("Liste PE").Visible = True
Sheets("Liste EM").Visible = True
Sheets("Liste ELC").Visible = True
Sheets("Liste Habilitation").Visible = True
Sheets("Liste EPC").Visible = True
Sheets("Liste ECH").Visible = True
Sheets("PICHON Franck").Visible = True
Sheets("MAGNIER Jean-Fran?ois").Visible = True
Sheets("LAPIERRE Louis").Visible = True
Sheets("HOSSAERT Didier").Visible = True
Sheets("DEBEYER Nicolas").Visible = True
Sheets("GARCIA Manuel").Visible = True
Sheets("GIRARD Sunny").Visible = True
Sheets("SICOT Thimot?e").Visible = True
Sheets("BEAUVILLAIN Maxime").Visible = True
Sheets("WATTEZ Eric").Visible = True
Sheets("PROUVOST Thomas").Visible = True
Sheets("PROUVOST Mathieu").Visible = True
Sheets("GARCIA Manuel").Visible = True
ActiveWorkbook.Protect Password:="password"
Unload Me
Else
MsgBox " Verifier le nom d'utilisateur ou le mot de passe"
End If
End If
End Sub
Private Sub CommandButton2_Click()
Unload Me
ActiveWorkbook.Close True
End Sub
`
it doesnt work as I want the problem is when I close my workbook and reopen it I have the recent sheets That ive been working on displayed on my workbook, and I want the worksheet "ACCEUIL" to be displayed not those Ive been working on the last time I opened the workbook.
thanks #karma it works very well, but I have something to ask, when i open my workbook i have a userform that pops up to edit/ read my database content when I finish working on my database and close the userform (UF_Choix_Service) i have all the worksheets visible again :/ but when im about to close the file I see in the background that the sheets have disappeared so your code is working good i just want to know how to hide the sheets after closing the userform.
My code to display the userfom is : (which I placed in a workbook module)
Sub Workbook_Open()
Gestion_Comp
end sub
where
Sub_Gestion_Comp ()
Application.ScreenUpdating = False
Nom_Classeur = ThisWorkbook.Name
mode_edition = False
UF_Choix_Service.Show
Select Case MsgBox("Voulez vous sauvegarder le fichier ?", vbYesNo + vbQuestion, "Sauvegarde du fichier")
Case vbYes
ThisWorkbook.Save
End Select
End Sub
enter image description here
Please have a look at this code,
maybe you can implement it to your needs.
Sub test()
Dim arr() As Variant
'get all sheet name except "Sheet1" to array
For Each sh In Worksheets
If sh.Name = "Sheet1" Then
Else
ReDim Preserve arr(X)
arr(X) = sh.Name
X = X + 1
End If
Next
'hide all the sheet name in that array, so the only not hidden is Sheet1
For Each sh In arr
If Sheets(sh).Visible = True Then Sheets(sh).Visible = False
Next
'show all the sheet name in that array
For Each sh In arr
If Sheets(sh).Visible = False Then Sheets(sh).Visible = True
Next
End Sub
I want the worksheet "ACCEUIL" to be displayed not those Ive been
working on the last time I opened the workbook.
Put your macro on the workbook module, something like this :
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim arr() As Variant
For Each sh In Worksheets
If sh.Name = "ACCEUIL" Then
Else
ReDim Preserve arr(X)
arr(X) = sh.Name
X = X + 1
End If
Next
For Each sh In arr
If Sheets(sh).Visible = True Then Sheets(sh).Visible = False
Next
End Sub
You need to save the workbook before you close it.
That's if I'm not mistaken what you want.
EDIT:
when I finish working on my database and close the userform
(UF_Choix_Service). I just want to know how to hide the sheets after closing the userform
If you want all the sheets hidden but the ACCEUIL sheet, then on the Sub where you have the line : Unload UF_Choix_Service try to put this line :
Unload UF_Choix_Service '---> this is your existing code to close the userform
For Each sh In Worksheets
If sh.Name = "ACCEUIL" Then
else
If Sheets(sh.Name).Visible = True Then Sheets(sh.Name).Visible = False
end if
Next
end sub
After the code unload/close the userform, the code above say :
Loop through all the existing worksheets,
If the sheet name is "ACCEUIL", do nothing
other than ACCEUIL,
if this other sheet is visible then hide it.
Don't forget to remove the sub I ask you to put in the workbook module (BeforeClose).
This is my second post about this macro. Although the first post received a few responses, none of the responses solved the problem (thank you for responding though).
Scenario:
I have about 20 sub-spreadsheets with links to external sources. The number of links per spreadsheet varies from about 500 to 10,000. A master spreadsheet calls macros to open each sub-spreadsheet in turn and update the links.
Each sub-spreadsheet has a dashboard that tells me how many links remain to be updated. This is done by counting the number of “N/A” values in each tab, then summing these counts in cell A20. As the links are updated, the value in A20 counts down to zero.
Sub Sub01()
Dim NAtotal As Integer
Set ActiveWKB = Workbooks.Open("Sub01.xlsm")
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.CalculateFull
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
NAtotal = Worksheets("Dashboard").Cells(20, "C").Value
MsgBox (NAtotal) 'Tells me how many cells remain to be updated – starts off at 4450.
NAtotal = 100 'Debugging effort to let me know that NAtotal does adjust.
MsgBox (NAtotal)
Do Until NAtotal = 0
Application.ScreenUpdating = True
MsgBox (NAtotal) 'Another debugging effort to monitor NAtotal. Starts at 100, then jumps to (and remains at) 4450 on the second loop and all subsequent loops.
NAtotal = Worksheets("Dashboard").Cells(20, "C").Value 'Resets NAtotal to the value in C20. This never changes, but remains at 4450.
DoEvents
Loop
Application.Calculation = xlManual
MsgBox ("Done")
Sheets("Dashboard").Activate
Range("B1").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub`
The macro should continue to loop until cell A20 hits zero, and then stop.
Cell A20 does count down, but variable NAtotal remains at its initial value.
Any guidance/recommendations are appreciated.
Hi the code below worked for me. Try use the same method instead of using a loop. The schedule will trigger every second until the NATotal = 0 logically anyway. Just update the code to fit your references.
Public firstOpen As Boolean
Sub testForm()
Dim cellCount As Integer
Dim s1 As Sheet1
Set s1 = Sheet1
Dim cellCol As Integer
Dim activeWbk As Workbook
Dim ws As Worksheet
If firstOpen = False Then
firstOpen = True
Set activeWbk = Workbooks.Open("C:\Example\Link2.xlsm")
Set ws = activeWbk.Sheets("Sheet1")
Application.Calculation = xlCalculationAutomatic
Application.CalculateFull
activeWbk.UpdateLink Name:=ActiveWorkbook.LinkSources
CreateNewSchedule
Exit Sub
Else
Set activeWbk = Workbooks("Link2.xlsm")
Set ws = activeWbk.Worksheets("Sheet1")
End If
cellCount = ws.Range("N2").Value
If cellCount = 0 Then
MsgBox ("Done...")
Application.Calculation = xlCalculationManual
firstOpen = false
Else
Debug.Print cellCount
CreateNewSchedule
End If
'Application.Calculation = xlCalculationManual
End Sub
Sub CreateNewSchedule()
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="testForm", Schedule:=True
End Sub
I have a macro that works perfectly well when triggered on an onchange event. It simply checks a cell value and hides or unhides rows elsewhere on the same active sheet. Here is the macro that hides or unhides rows:
Sub ToggleTaskTable()
MsgBox "Toggling Tasks"
If Cells(56, 3).Value = "No" Then
Cells(57, 1).EntireRow.Hidden =
MsgBox "Hding Rows 106, 148 and 190"
ActiveSheet.Rows("106").Hidden = True
ActiveSheet.Rows("148").Hidden = True
ActiveSheet.Rows("190").Hidden = True
' try it another way
Rows("106").Hidden = True
Rows("148").Hidden = True
Rows("190").Hidden = True
Else
Cells(57, 1).EntireRow.Hidden = False
' MsgBox "Showing task Rows 106, 148 and 190"
Rows("106").Hidden = False
Rows("148").Hidden = False
Rows("190").Hidden = False
End If
End Sub
If I call the macro as a result of changing a cell C56 to "No", it works perfectly.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$56" Then
Call ToggleTaskTable
End If
End Sub
If I call the macro from another macro, with C56 set to "No", it does not work at all.
Sub CallAllMacros()
Call ToggleTaskTable
End Sub
Even though the msgbox shows indicating it is hiding the rows, it does not actually hide them.
I am totally stumped!
Sub ToggleTaskTable()
With ActiveSheet
.Range("A57,A106,A148,A190").EntireRow.Hidden = (.Cells(56, 3).Value = "No")
End With
End Sub
I am facing a problem in my excel workbook. I have 25+ sheets in my workbook
and I want to look to sheet1 time to time. Is their any way that I can freeze first
two sheets of my workbook?
Currently I am navigating through sheets by pressing ctrl+page up button.
FYI I am Using MS-Office 2007
If I have understood well: you want the users stay only on Sheet1 & 2:
In the Main event:
Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = False
End Sub
and in the Event:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveWindow.DisplayWorkbookTabs Then ActiveWindow.DisplayWorkbookTabs = False
If ((Sh.Name) <> "Sheet1") And ((Sh.Name) <> "Sheet2") Then Sheets("Sheet1").Select
End Sub
When open disable Tabs. If people show if you try to change the code return to Sheet1.
Ad Password to VBA macro ...If is only for quick change remove the code of Tabs...
This code (in the ThisWorkbook module) will keep Sheet1 just to the left of whatever sheet you're on.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.EnableEvents = False
If Sh.Name <> Sheet1.Name Then
Sheet1.Move Sh
Sh.Activate
End If
Application.EnableEvents = True
End Sub
It's a little weird pressing Ctrl+PgUp to navigate a bunch of sheets because it now takes two Ctrl+PgUps to move one sheet - one moves you onto Sheet1 (because it's always to the left) and the second moves you to the next sheet (which then moves Sheet1 to the left of it).
Maybe you could build in a timer so it only moves sheet1 if you've been on a sheet for a couple of seconds.
Update Using a timer
In a standard module:
Public gshToMove As Object
Public gdtTimeToMove As Date
Sub MoveSheet()
Application.EnableEvents = False
Sheet1.Move gshToMove
gshToMove.Activate
Set gshToMove = Nothing
gdtTimeToMove = 0
Application.EnableEvents = True
End Sub
In the ThisWorkbook module
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name <> Sheet1.Name Then
'if something's schedule, unschedule it
If gdtTimeToMove <> 0 Then
Application.OnTime gdtTimeToMove, "MoveSheet", , False
End If
'schedule the sheet move for three seconds from now
gdtTimeToMove = Now + TimeSerial(0, 0, 3)
Set gshToMove = Sh
Application.OnTime gdtTimeToMove, "MoveSheet", , True
End If
Application.EnableEvents = True
End Sub
You still get a little flash when the code actually runs.
In each sheet
Private Sub Worksheet_Activate ( )
Call Funciona
End Sub
In Module
Sub Funciona()
With ActiveSheet
If .Index > 1 Then
If .Previous.Name <> "Principal" Then
Sheets("Principal").Move Before:=ActiveSheet
End If
End If
End With
End Sub
Update to code & question:
The current code in the module for this sheet is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B2")) Is Nothing Then
Application.Run "MonthlyRead"
End If
End Sub
Sub MPrintAll()
Dim c As String
Dim MonthlyList As Range
Set MonthlyList = Worksheets("Monthly").Range("MonthlyList").Cells
For Each cell In MonthlyList
Range("b2").Value = cell.Value
ActiveWorkbook.Worksheets("Monthly").PrintOut
Next cell
End Sub
I've been stepping through the code, to try to identify where the problems occur. When I press F8 after "Range("b2").Value = cell.Value" it immediately goes to the first line of code for the sheet, completely skipping the Print command. Also, it deletes the first value in the named range, instead of copy-pasting it to cell B2.
For reference, here's the code in Module1 called by the first routine above:
Sub MonthlyRead()
Call MEFTPS
Call MUCT6
End Sub
Sub MEFTPS()
If Range("a2").Value = "EFTPS Package" Then
Call MShow
Else: Call MHide
End If
End Sub
Sub MHide()
Rows("20:20").Select
Selection.EntireRow.Hidden = True
Rows("31:31").Select
Selection.EntireRow.Hidden = True
Rows("42:42").Select
Selection.EntireRow.Hidden = True
Rows("53:53").Select
Selection.EntireRow.Hidden = True
Range("B2").Select
End Sub
Sub MShow()
Rows("20:20").Select
Selection.EntireRow.Hidden = False
Rows("31:31").Select
Selection.EntireRow.Hidden = False
Rows("42:42").Select
Selection.EntireRow.Hidden = False
Rows("53:53").Select
Selection.EntireRow.Hidden = False
Range("B2").Select
End Sub
Sub MUCT6()
If Range("g3").Value = "Y" Then
Call UCT6MShow
Else: Call UCT6MHide
End If
End Sub
Sub UCT6MHide()
Rows("19:19").Select
Selection.EntireRow.Hidden = True
Rows("30:30").Select
Selection.EntireRow.Hidden = True
Rows("41:41").Select
Selection.EntireRow.Hidden = True
Rows("52:52").Select
Selection.EntireRow.Hidden = True
Range("B2").Select
End Sub
Sub UCT6MShow()
Rows("19:19").Select
Selection.EntireRow.Hidden = False
Rows("30:30").Select
Selection.EntireRow.Hidden = False
Rows("41:41").Select
Selection.EntireRow.Hidden = False
Rows("52:52").Select
Selection.EntireRow.Hidden = False
Range("B2").Select
End Sub
I'm working with a dynamic worksheet that populates an individualized payment schedule, based on a selection from a data validation drop-list at the top of the page. There are approximately 300 options in the drop-list. These schedules are then printed, to verify information obtained from 2 other programs, all of which must be printed, copied, scanned, packed, and mailed in a single day.
I'm looking for VBA code that can select each client name from the drop-list in order, from the beginning to the end of the list. The list is populated from a named range on another sheet, named "QtrlyList."
I have some very simple code, that doesn't work.
Sub PrintAll()
For Each cell In QtrlyList
Worksheets("Normal").PrintOut
Next cell
End Sub
Whenever I try to run the code, I get a "Type Mismatch" error. I'm fairly certain this is coming from "cell" or "QtrlyList." I'm just not sure how to fix it.
Something like this might work for you (untested)
Sub PrintAll()
Dim wb as Workbook, cell as Range
Set Wb = ActiveWorkbook 'or ThisWorkBook if the code is in your reporting workbook
For Each cell In wb.Sheets("SheetNameHere").Range("QtrlyList").Cells
With wb.Worksheets("Normal")
'you want to set the value of whichever cell has the drop-down
.Range("D2")).value=cell.Value
DoEvents 'allow sheet to pick up changed value
.PrintOut
End with
Next cell
End Sub