I am programmatically placing a button on a worksheet and it places fine, however when I click it i get an error saying "Cannot run the macro. The macro may not be available in this workbook or all macros may be disabled". I believe I've set it up fine but here is my code if anyone spots anything would greatly appreciate it.
Sub ButtonGenerator()
Application.ScreenUpdating = False
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim lcolumncrc As Long
lcolumncrc = CRC.LastColumnInCRC
'Button Declarations
Dim ShowHideDates As Button
wsCRC.Buttons.Delete
'Show/Hide Dates Button Set Up
Dim SHDrange As Range
Set SHDrange = wsCRC.Range(Cells(5, lcolumncrc + 2), Cells(5, lcolumncrc + 4))
Set ShowHideDates = wsCRC.Buttons.Add(SHDrange.Left, SHDrange.Top, SHDrange.Width, SHDrange.Height)
With ShowHideDates
.OnAction = "wsCRC.SHDbtn"
.Caption = "Show Hidden Date Columns"
.Name = "ShowHideDates"
End With
Application.ScreenUpdating = True
End Sub
Sub SHDbtn()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim ShowHideDates As Button
Dim CurrentDateColumn As Long
CurrentDateColumn = GetTodaysDateColumn()
ActiveSheet.Unprotect
If ShowHideDates.Caption = "Hide Old Date Columns" Then
wsCRC.Range(wsCRC.Cells(5, 10), wsCRC.Cells(5, CurrentDateColumn - 6)).EntireColumn.Hidden = True
ShowHideDates.Caption = "Show Hidden Date Columns"
Else
wsCRC.Range(wsCRC.Cells(5, 10), wsCRC.Cells(5, CurrentDateColumn - 6)).EntireColumn.Hidden = False
ShowHideDates.Caption = "Hide Old Date Columns"
End If
ActiveSheet.Protect
End Sub
You're referring to a worksheet by the label you've given it within your code, not as a sheet itself.
Try changing:
.OnAction = "wsCRC.SHDbtn"
to
.OnAction = "CRC.SHDbtn"
or even
.OnAction = "SHDbtn"
Related
Last week i upgraded office from 16 to O365, everything seemed fine at the beginning...
I have a function that calls a userform to get a signature and place it on a hidden worksheet(layout) that will be printed in a second moment.
with office 16 i had no problems placing the signature on a hidden sheet, but with office O365, it just continues to assign the wrong top value...
I noticed that if the target sheet is active the top property of the target shape works fine, but if the sheet is not active o hidden, excel does not assign the correct value to the top property of the target shape. This issue was not present in office 2016.
Here is an example code:
Private Sub SetSignature()
Dim userSign As Shape 'picture (shape)
Dim filePth As String 'picture path
Dim signatureRng As Range 'range at which the picture will be placed
filePth = "C:\Users\UserX\Desktop\signature.png"
Set signatureRng = ThisWorkbook.Sheets("LayoutDoc").Range("A48")
Set userSign = ThisWorkbook.Sheets("LayoutDoc").Shapes.AddPicture(filePth, False, True, 1, 1, 1, 1)
With userSign
.ScaleHeight 0.4, True
.ScaleWidth 0.4, True
.Top = signatureRng.Top - Application.CentimetersToPoints(0.3)
.Left = signatureRng.Left + Application.CentimetersToPoints(0.1)
.Name = "Signature1"
End With
End Sub
And here is the full function:
Private Function GetSignature() As String
Dim signaturePath As String 'Signature path
Dim userSign As Shape 'Signature img
Dim filePth As String 'Signature file path
Dim signatureRng As Range 'range at which the signature should be placed
Dim checkTopSignature As Boolean 'used to check if the picture top was set correctly
Dim sheetVisibilty As Integer 'sheet visibility
Dim curScreenUpSt As Boolean 'current screenupdating state
filePth = PJ_PubVar.firmeTempDir & "\" & PJ_PubVar.kFirmaApPrepInt & nuovoPermesso.ID & PJ_PubVar.firmaExtenion
'assign the range at which the signture will be placed
Set signatureRng = ThisWorkbook.Sheets(WB_PubVar.curWB_wsLayoutPermesso).Range(WB_PubVar.curWB_rngOraFirmaInizioInt)
'get sheet visibility
sheetVisibilty = ThisWorkbook.Sheets(WB_PubVar.curWB_wsLayoutPermesso).Visible
'get current screenupdating state
curScreenUpSt = Application.ScreenUpdating
'userform to get the signature from the user
With FormSignature
.filePath = filePth
.Show
End With
'if signature acquired, then save the signature address and add it to the document layout
If firmaAquisita Then
signaturePath = filePth
'add the signature to the sheet (hidden)
Set userSign = ThisWorkbook.Sheets("LayoutDoc").Shapes.AddPicture(signaturePath, False, True, 1, 1, 1, 1)
'setup picture position and dimentions
With userSign
.ScaleHeight PJ_PubVar.perceMisuFirma, True
.ScaleWidth PJ_PubVar.perceMisuFirma, True
'******************************************************************************************************************************************
'******************************************************************************************************************************************
'**** 04/15/2022:
'**** After switching to Office 365, I noticed that when the sheet is not active (or hidden) the top of the picture is assigned incorrectly
'**** as a work arround I had to assign the same value of the top of the range to the image top
'**** check if the values are the same, if they are the same (office 2016) I proceed normally
'**** otherwise, I unlock the wb and activate the worksheet
'**** I set top, left and name
'**** set back the worksheet visiblity and the workbook protection as before
'assign the same value of the top of the range to the image top
.Top = signatureRng.Top
'check if the values are the same
checkTopSignature = (.Top = signatureRng.Top)
If Not checkTopSignature Then
'I unlock the wb and activate the worksheet
Application.ScreenUpdating = False
ThisWorkbook.Unprotect (WB_PubVar.curWB_Password)
With Sheets(WB_PubVar.curWB_wsLayoutPermesso)
.Visible = xlSheetVisible
.Activate
End With
'set top, left and name of the picture
.Top = signatureRng.Top - Application.CentimetersToPoints(PJ_PubVar.offsetFirmaInCm_H)
.Left = signatureRng.Left + Application.CentimetersToPoints(PJ_PubVar.offsetFirmaInCm_W)
.Name = WB_PubVar.curWB_imgFirmaInizioInt
'set back the worksheet visiblity and the workbook protection as before
Sheets(WB_PubVar.curWB_wsLayoutPermesso).Visible = sheetVisibilty
ThisWorkbook.Protect (WB_PubVar.curWB_Password)
Application.ScreenUpdating = curScreenUpSt
Else
.Top = signatureRng.Top - Application.CentimetersToPoints(PJ_PubVar.offsetFirmaInCm_H)
.Left = signatureRng.Left + Application.CentimetersToPoints(PJ_PubVar.offsetFirmaInCm_W)
.Name = WB_PubVar.curWB_imgFirmaInizioInt
End If
'******************************************************************************************************************************************
'******************************************************************************************************************************************
End With
Else
signaturePath = ""
End If
GetSignature = signaturePath
End Function
Here is a screenshot of the issue.. even if i assign the range.top value to the picture.top, vba just ignores it...
Does anyone know what is wrong?
Is it a bug with office 365?
Thanks in advance.
Hello i found you message and i have the same issue i thinks.
I just want position a picture in top left corner of a cell. The higher the index of the row, the more the offset is visible.
Exemple : https://imgur.com/5id3KsY
My goal was to make autocomplete active for dropdowns and I have achieved it for a single worksheet but duplicating the code to other worksheets is not working.
I started by creating a combo Box on the initial worksheet containing the drop downs and then made the following changes-
Changed the name to TempCombo in the Name field
Selected 1-fmMatchEntryComplete in the MatchEntry field;
I then inserted the following code for that worksheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal
`Shift As Integer)`
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
This implementation works perfectly for that sheet but when i attempt to use the same code on another worksheet on the same file the autocomplete function doesn't work.
I attempted modification of the combobox name on sheet2 to TempCombo2 and changed the following line:
Set xCombox = xWs.OLEObjects("TempCombo")
to
Set xCombox = xWs.OLEObjects("TempCombo2")
The autocomplete function fails to work on sheet 2 even though no error is thrown.
This is a pretty interesting idea, I like it.
I was able to get this to work on multiple sheets with the following modifications:
Removed Cancel = True, this line was throwing an error and Cancel is not an argument in Worksheet_SelectionChange; I don't think this is doing anything.
Copied the code to the second sheet's code module (it has to be in each sheet module that you want it to run on)
updated Set xCombox = xWs.OLEObjects("TempCombo") to Set xCombox = xWs.OLEObjects("TempCombo2")
Me.TempCombo.DropDown updated to Me.TempCombo2.DropDown since that is what I named the combo box on the second sheet
Also, not a change as much as an assumption, it seems it only works with the ActiveX controls, so I assume that's what you are using when you add the new box.
As a follow up I was able to get it to work using the workbook module as long as the combo box is named "TempCombo" on all sheets (you have to add a combobox named "TempCombo" to each sheet). Going this route, you only need the code once, on the workbook module , and it uses the combo box that is local to each sheet.
TO TEST - In a new workbook: add list validation to a range using a range reference, put some values in the list range, add an ActiveX combobox to the sheet and name it "TempCombo", put the following code in the workbook module, then click anywhere in the range that has the list validation enabled.
One other note, make sure you aren't still in design mode on the developer tab!
Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Set xWs = Sh
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
'Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
.LinkedCell = Target.Address
End With
xCombox.Activate
Sh.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
I have use a button (by clicking) to create a new sheet and insert a button on it, but I want to import codes to the new button (here is MyPrecodedButton).
Private Sub CommandButton1_Click()
Dim z As Integer
Dim wb As Workbook
Dim ws2 As Worksheet, wsnew As Worksheet
Set wb = ThisWorkbook
Set ws2 = wb.Sheets("Sheet2")
z = ws2.Cells(2, 1).Value
Set wsnew = Sheets.Add ' Declare your New Sheet in order to be able to work with after
wsnew.Name = "PIAF_Summary" & z
z = z + 1
With wsnew.Range("A1:G1")
.Merge
.Interior.ColorIndex = 23
.Value = "Project Name (To be reviewed by WMO)"
.Font.Color = vbWhite
.Font.Bold = True
.Font.Size = 13
End With
ws2.Cells(2, 1).Value = z
Dim Rngc As Range: Set Rngc = wsnew.Range("F35")
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=Rngc.Left, Top:=Rngc.Top, Width:=205, Height:=20)
.Name = "MyPrecodedButton" ' change the name
End With
End sub
Here is the code for MyPrecodedButton
Public Sub MyPrecodedButton_Click()
MsgBox "Co-Cooo!"
End Sub
Let's demonstrate briefly what you can do with VBA to Add buttons.
Below code will Add a button to cell B2 if the ActiveSheet is not "Sheet1".
Option Explicit
Sub SayHello()
MsgBox "Hello from """ & ActiveSheet.Name & """"
End Sub
Sub AddButton()
Dim oRng As Range
Dim oBtns As Buttons ' Add "Microsoft Forms 2.0 Object Library" to References if you want intellisense
If ActiveSheet.Name <> "Sheet1" Then ' Only works if it's not "Sheet1"
Set oRng = Range("B2")
Set oBtns = ActiveSheet.Buttons
With oBtns.Add(oRng.Left * 1.05, oRng.Top * 1.05, oRng.Width * 0.9, oRng.Height * 2 * 0.9)
.Caption = "Say Hello!"
.OnAction = "SayHello"
End With
Set oBtns = Nothing
Set oRng = Nothing
End If
End Sub
Before and After screenshots:
Now Clicking on the button:
So, if you code is generic enough (to work with all your possible situations), there is no need to Add Codes via code. i.e. have your codes ready, then just assign the button's OnAction property to call the correct Sub.
Hi I have encountered problem with my listbox data in my Userform
When I try to change the source file where my listbox connected it doesn't seems to change
It was showing good data at first but when I try to click RUN DATE button
It doesn't go with the Value in my Range that is being set as My key for sorting
Here is my code for RUN DATE BUTTON for sorting Ascending and Descending
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
End Sub
And this is how I initialize the value in my listbox
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
'Load Worksheet Range directly to a ListBox:
Dim var As Variant
var = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = var
End Sub
Is there a way to refresh my listbox? Listbox1.refresh something like that?
Note: I don't need to close my Userform and open again to see the updated listbox
so while the Userform is in active mode(Open) I can directly update the listbox value..
Thanks
Instead of using var and assigning the data to List from var, you can use Named Range of data in the sheet and assign the property
ListBox1.RowSource = "Name of the Range"
Every time you want to refresh the listbox just use the above assignment in your code and it will work. If you find any difficulty please let me know.
You could add a refresh procedure, then call it in your OnClick event procedure for the button.
Note, I haven't tested this code, but it should do what your original question asked.
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
RefreshListbox
End Sub
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
RefreshListbox
End Sub
Private Sub RefreshListbox()
Me.ListBox1.Clear
'Load Worksheet Range directly to a ListBox:
Dim ListRange As Range
ListRange = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = ListRange
End Sub
I want to display to the user certain information that exists on a separated worksheet, whenever he clicks a button.
I can set Excel to "go" to this worksheet at the starting line of the range , but I could not find a way to hide everything else.
Is there some method for this, or do I have to hide all rows and columns?
Insert a UserForm in the Workbook's VB Project.
Add a ListBox control to the userform.
Then do something like this code in the UserForm_Activate event code:
Private Sub UserForm_Activate()
Dim tbl As Range
Set tbl = Range("B2:E7") '## Change this to capture the rang you need '
Me.Caption = "Displaying data from " & _
ActiveSheet.Name & "!" & tbl.Address
With ListBox1
.ColumnHeads = False
.ColumnCount = tbl.Columns.Count
.RowSource = tbl.Address
End With
End Sub
Which gives unformatted data from the range:
To export the range as an image, you could create an Image in the UserForm instead of a Listbox. Then this should be enough to get you started.
As you can see from this screenshot, the image might not always come out very clearly. Also, if you are working with a large range of cells, the image might not fit on your userform, etc. I will leave figuring that part out up to you :)
Private Sub UserForm_Activate()
Dim tbl As Range
Dim imgPath As String
Set tbl = Range("B2:E7") '## Change this to capture the rang you need '
imgPath = Export_Range_Images(tbl)
Caption = "Displaying data from " & _
ActiveSheet.Name & "!" & tbl.Address
With Image1
If Not imgPath = vbNullString Then
.Picture = LoadPicture(imgPath)
.PictureSizeMode = fmPictureSizeModeClip
.PictureAlignment = 2 'Center
.PictureTiling = False
.SpecialEffect = 2 'Sunken
End If
End With
End Sub
Function Export_Range_Images(rng As Range) As String
'## Modified by David Zemens with
' credit to: _
' http://vbadud.blogspot.com/2010/06/how-to-save-excel-range-as-image-using.html ##'
Dim ocht As Object
Dim srs As Series
rng.CopyPicture xlScreen, xlPicture
ActiveSheet.Paste
Set ocht = ActiveSheet.Shapes.AddChart
For Each srs In ocht.Chart.SeriesCollection
srs.Delete
Next
'## Modify this line as needed ##'
fname = "C:\users\david_zemens\desktop\picture.jpg"
On Error Resume Next
Kill fname
On Error GoTo 0
ocht.Width = rng.Width
ocht.Height = rng.Height
ocht.Chart.Paste
ocht.Chart.Export Filename:=fname, FilterName:="JPG"
Application.DisplayAlerts = False
ocht.Delete
Application.DisplayAlerts = True
Set ocht = Nothing
Export_Range_Images = fname
End Function
If you record a macro and hide some columns and rows manually, the code will be produced for you, and you will see how it's done.