I am trying to lock the aspect/visual options of an excel file, so when other people open it, it remains as I set and cannot change it.
When I set the aspect options and other people open it in their PCs, all settings are gone.
I would like to set the aspect as the following:
Do not show formula bar
Do not show headings
Minimize the Ribbon
Additionally I would like to lock specific settings for each sheet:
Zoom:
100% for sheet 1 and 4
90% for sheet 2 and 3
Freeze panes:
Unfreeze for sheet 1 and 4
Freeze the first 3 columns for sheet 2 and 3
Is there anyway of doing this?
Thanks!
I used this in the 'thisworkbook' excel object. The send keys worked but i would be careful as these are prone to errors.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet4" Then
ActiveWindow.FreezePanes = False
ActiveWindow.Zoom = 90
ElseIf ActiveSheet.Name = "Sheet2" Or ActiveSheet.Name = "Sheet3" Then
Columns("d:d").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 90
End If
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
If Application.CommandBars("Ribbon").Height >= 150 Then
SendKeys "^{F1}"
End If
End Sub
Hopefully this will work, if not let me know!
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet4" Then
ActiveWindow.FreezePanes = False
ActiveWindow.Zoom = 90
ElseIf ActiveSheet.Name = "Sheet2" Or ActiveSheet.Name = "Sheet3" Then
Columns("d:d").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 90
End If
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
End Sub
Related
I have a few userforms. One is a popup that shows instructions and another is for entering quantities. Problem is when I click one and close it (each closes with Unload Me) then when I switch sheets with a sht.Activate macro button that sheet won't scroll. Looks like the sheet is frozen. I can fix the problem by loading the userform and closing it again on the current sheet to "Unfreeze" the sheet.
Any idea why this is happening?
UserForm
Private Sub UserForm_Click()
Unload Me
End Sub
Below is how I call it from a button.
Sub Instructions()
With UserFormInstructions
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
.Show
End With
End Sub
Sheet Button
Sub goto630()
Application.ScreenUpdating = False
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets("Foundation Plates")
Dim sht3 As Worksheet
Set sht3 = ThisWorkbook.Worksheets("630 BOM")
sht3.Activate
sht3.Unprotect
sht2.Visible = True
sht3.Visible = True
On Error GoTo 0
ActiveWindow.Zoom = 90
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.DisplayFormulaBar = True
sht3.DisplayPageBreaks = False
sht2.Protect
sht3.Protect _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterFaceOnly:=False, _
AllowFormattingCells:=True
Call NoSelect
Set sht3 = Nothing
Application.ScreenUpdating = True
End Sub
Sub NoSelect()
Application.ScreenUpdating = False
Range("D1").Select
ActiveWindow.SmallScroll ToLeft:=4
Application.ScreenUpdating = True
End Sub
Thanks
I have one table in the database sheet in which i would want to paste link to another sheet. However i realised that it is not possible using excel and vba. Is there any ways to reference these tables automatically? Equating the cell ranges is one way that i know of but it is extremely tedious because i have over 50 tables of such. Hard coding these equations are a trouble.This is a basic code I have done to copy paste a table .
Sub table()
ActiveSheet.ListObjects("Table1").Range.Copy
'This code will run only when the cursor is at activesheet
Sheets("Sheeet2").Range("A2").PasteSpecial xlPasteValues
End Sub
Here is an example of how to add Table Connections to a new Workbook and a way to Refresh the tables.
The code steps through each ListObject in ListObjects (Tables), .Add's the connection to the new Workbook and places the Table into the Worksheet.
It then creates a new Worksheet and process the next ListObject.
You can change the Workbook and Worksheet names + path to your needs.
*Do note that for unknown reasons to me the Table mixes the rownumbers up when placing them into the new Worksheet, it however doesn't mix the Columns.
AddTableConnectionsToNewWB code:
Sub AddTableConnectionsToNewWB()
Dim tbl As ListObject
Dim tblConn As ListObjects
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks("TableConnections.xlsm")
Set tblConn = Workbooks("TestBook3.xlsm").Worksheets("Sheet2").ListObjects
For Each tbl In tblConn
wb.Connections.Add2 "WorksheetConnection_TestBook3.xlsm!" & tbl, _
"", "WORKSHEET;H:\Projects\TestBook3.xlsm", "TestBook3.xlsm!" & tbl, 7, True, _
False
If wb.Worksheets.Count = 1 Then
With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _
"$A$1")).TableObject
.RowNumbers = False
.PreserveFormatting = True
.RefreshStyle = 1
.AdjustColumnWidth = True
.ListObject.DisplayName = tbl.Name
.Refresh
End With
wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)
Else
With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _
"$A$1")).TableObject
.RowNumbers = False
.PreserveFormatting = True
.RefreshStyle = 1
.AdjustColumnWidth = True
.ListObject.DisplayName = tbl.Name
.Refresh
End With
If tblConn.Item(tblConn.Count).Name <> tbl.Name Then
wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count)
End If
End If
Next
Application.ScreenUpdating = False
End Sub
Refresh code (this can also be done by simply clicking the refresh all button in Table Tools):
Sub RefreshTableConnections()
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks("TableConnections.xlsm")
wb.RefreshAll
Application.ScreenUpdating = True
End Sub
I have a project which requires Excel to hide rows on a separate sheet(within the same workbook) after user selects specific options on the activesheet. The macro is linked to a button, when clicked rows will be hidden on the separate sheet, and the whole process occurs in the background. If the user want to check the table with hidden rows they'd need to navigate to that separate sheet to see the result.
Image explanation:
http://postimg.org/image/ek6981vg1/
Worksheets("Input- Select Pens") --> active sheet where has the button
Worksheets("Input- Pen") --> separate sheet where has the hidden rows
I have tried several methods, but none of them worked:
Method 1:
Sub selectPens()
Dim c As Range
Application.EnableEvents = False
On Error Resume Next
For Each c In Range("E6:E35")
If c.Value = "FALSE" Then
Worksheets("Input- Pen").c.EntireRow.Hidden = True
ElseIf c.Value = "TRUE" Then
Worksheets("Input- Pen").c.EntireRow.Hidden = False
End If
Next c
On Error GoTo 0
Application.EnableEvents = True
End Sub
Method 2:
Sub selectPens()
Dim i As Long
Set wselect = Sheet11
With wselect
For i = 6 To 35
If ActiveSheet.Cells(i, 5).Value = "FALSE" Then
.Range("i:i").EntireRow.Hidden = True
' .Rows(i).EntireRow.Hidden = True
ElseIf ActiveSheet.Cells(i, 5).Value = "TRUE" Then
' .Rows(i).EntireRow.Hidden = False
.Range("i:i").EntireRow.Hidden = False
End If
Next i
End With
End Sub
I would be greatly appreciated for any help.
Many thanks!
Sub selectPens()
Dim i As Long, wsselect
Set wselect = Sheet11
For i = 6 To 35
'EDIT
wselect.Rows(i).Hidden = (ActiveSheet.Cells(i, 5).Value = False)
Next i
End Sub
So I've been playing around with macros and buttons and I am trying to make a button, that on clicking it, it will go to the previous sheet (they are names Day 1, 2, 3, etc...) so I figure this shouldn't be too difficult!
Here is the code that I have got so far:
Sub Previous_Day()
Worksheets("Day " & (sheetNum - 1)).Visible = xlSheetVisible
Worksheets("Day " & (sheetNum - 1)).Activate
Worksheets("Day " & sheetNum).Visible = xlSheetHidden
sheetNum = sheetNum - 1
End Sub
I get an error when I click the button with this which says "subscript out of range", I'm not entirely sure why this is happening, I globally define sheetNum in the 'This Workbook' module, and I shall show that code below:
Public sheetNum As Integer
Private Sub Workbook_Open()
Dim thisSheet As Worksheet
Dim sh As Worksheet
Dim start As Worksheet
Dim shName As String
Dim lastSheet As String
'name of the sheet template
shName = "Food Diary Template.xltm"
lastSheet = "Food Diary Last Entry.xltm"
Set start = Worksheets(1)
With start
If .Range("A1") = "" Then
.Range("A1") = Date
ActiveSheet.Shapes("Button 5").Select
Selection.Delete
.Range("B4").Select
End If
End With
Worksheets(Sheets.Count).Activate
'#### I like to use variables for worksheets:
Set thisSheet = ThisWorkbook.ActiveSheet
'Insert sheet template
With thisSheet
If .Range("A1") < Date Then
ActiveSheet.Buttons.Add(436.5, 104.25, 58.5, 18.75).Select
Selection.OnAction = "nextDay_Click"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "Button 1"
With Selection.Characters(start:=1, Length:=8).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "Next Day"
With Selection.Characters(start:=1, Length:=8).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
.Range("B4").Select
Set sh = Sheets.Add(Type:="C:\Users\edawes\AppData\Roaming\Microsoft\Templates\" & lastSheet, _
after:=Sheets(Sheets.Count))
'#### Put today's date in the new sheet:
sh.Range("A1") = Date
sh.Name = "Day " & Worksheets.Count
'Worksheets(sh).Active
sh.Range("B4").Select
'#### Hide the old sheet
.Visible = xlSheetHidden
End If
End With
sheetNum = Sheets.Count
End Sub
This bit works fine as I want it to, but it's the sheetNum that I'm not sure about, have I done it right? I want it to be the total number of sheets when the file is opened and then when the button is pressed, (there is also a next day button, but that will be pretty simple when I get this one working), it will update the sheetNum variable so that it can keep track and the previous button can keep being pressed...
Any ideas?
You could just parse the Name of he active sheet, subtract one from the day number and activate the previous sheet.
Sub ButtonCode()
dy = CLng(Split(ActiveSheet.Name, " ")(1))
dy = dy - 1
If dy = 0 Then Exit Sub
Sheets("Day " & dy).Activate
End Sub
So if the name of the active sheet is Day 4, then sheet Day 3 would be activated.
I wonder if anybody can help me. I have a macro which selects sheets that are named as employees and puts them into the correct workbook dependant on where they work.
I have made the macro so that it selects all sheets for the depot then copies them into a new workbook.
My problem is when it can't find one of the sheets it skips all of them for that location workbook. and moves to the next location. Is there a way round this so if the macro can't find one of the sheets it moves the rest of them anyway.
Sub BIR()
On Error GoTo Getout
Sheets(Array("Martyn Arthur Lewis", "Norman Stewart Gray")).Move
Sheets.Select
For Each ws In Worksheets
ws.Activate
With ActiveSheet.PageSetup
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.printerrors = xlPrintErrorsBlank
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
Next
ChDir "\\afi-uplift\documents\company\Support Services\Support Services Level 1\Reports\Transport Reports\Vehicle KPI"
ActiveWorkbook.SaveAs Filename:="\\afi-uplift\documents\company\Support Services\Support Services Level 2\Support Services\Transport\Drivers\Driver Performance\BIR Driver KPI " & Format(Date, "yyyy.mm.dd") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("Driver Report.xlsm").Activate
Getout:
End Sub
I don't understand why people always need to use .select and .activate
First it slows the program, and second, usualy, you don't even need to select/activate.
Doesn't your code work if you write it like this :
option explicit 'forces user to dim variables, , alot easier to find errors
err.clear
on error goto 0 'how can you debug errors with a on error goto (or on error resume next) ?
dim ws as worksheet
For Each ws In Sheets(Array("Martyn Arthur Lewis", "Norman Stewart Gray"))
With ws.PageSetup
'your code
end with
next ws