I'm using the code below to add a toggle button to sheet. I will need to dynamically re-create a sequence of buttons, and give them name and caption.
Can anyone help me with a way to change the caption/text of the toggle button button added using VBA? The bName will change so I will need a way to reference them by name.
Set Bttn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
With Bttn
.Name = bName
End With
where R is the target cell where button will be added
I tried the following, and they all error out:
Bttn.caption = bText
ActiveSheet.Shapes(bName).Text = bText
Or, simply . . .
With Bttn
.Name = bName
.Object.Caption = "MyCaption"
End With
I found this workaround here: https://stackoverflow.com/a/37978572/9852011
Not sure why you need to do this exactly but this code should work for you:
Dim Bttn As OLEObject, aButton As Variant
Set Bttn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
With Bttn
.Name = bName
End With
Set aButton = Bttn.Object
aButton.Caption = "whateverYouWant"
Related
i'm making a code for Excel that opens every file in a specific folder. When the file is open I like to add a button to each of these files at the same location. I made this code shown as below. but somehow I get this error:
Run-Time Error '1004': Unable to get the Add property of the
OLEObjects class
The code breaks on the line where it says: set addbutton = etc...
Does anyone know why?
My Code:
Dim AddButton As OLEObject
Set AddButton =
Workbooks(ThisWB).Sheets("Planning").OLEObjects.add(ClassType:="Forms.CommandButton.1", Link:=False,
DisplayAsIcon:=False, Left:=3.52941176470588, Top:=106.764705882353,
Width:=47.6470588235294, Height:=24.7058823529412)
With AddButton
.Name = "SortPlanner"
.OnAction = "SortPersonalPlanner"
With .Object
.Caption = "Sorteren"
.BackColor = &HFFFFFF
End With
End With
You can do something like this, use .Buttons.Add instead of .OLEObjects.add
Set AddButton = Workbooks(ThisWB).Sheets("Planning").Buttons.Add(3.53, 106.76, 47.65, 24.71)
With AddButton
.Characters.Text = "Sorteren"
.Font.Bold = True
.OnAction = "SortPersonalPlanner"
End With
I would like a VBA code to put this button lets say two cells (to the right) away from a cell in the sheet called "hello". Here's the command button code:
Set objBtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=480, Top:=200, Width:=90, Height:= _
30)
objBtn.Name = "button1"
I don't want to use the cell location as reference, instead the cell value which is "hello". So maybe first I want to look for the value and then insert the command button relative to it.
Yes, that's the way to do it, e.g.
Sub x()
Dim objBtn As OLEObject, r As Range
Set r = Cells.Find("hello") 'should specify more parameters than this
If Not r Is Nothing Then
Set objBtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=r.Offset(, 2).Left, Top:=r.Top, Width:=90, Height:=30)
objBtn.Name = "button1"
End If
End Sub
'You can fixe a button to a specific cell here to cell A1
Dim rngcbn1 As Range
Set rngcbn1 = ActiveSheet.Range("A1")
With ActiveSheet.OLEObjects("CommandButton1")
.Top = rngcbn1.Top
.Left = rngcbn1.Left
.Width = rngcbn1.Width
.Height = rngcbn1.RowHeight
End With
I've got a question concerning combobox in Excel.
I've got an excel sheet that by default contains two comboboxes and their number is described by a variable x (x=2 by default). Each combobox is scripted to behave in a particular way in subs, for example I've got: private sub ComboBox1_DropButtonClick().
Nonetheless, sometimes I need to increase the number of these boxes by changing the value of X. I may need up to 10 comboboxes in total. Now the question is whether there's any way in which I can set the behaviour of an infinite number of comboboxes (for example in the event of DropButtonClick). What I did was to write a code for each of those comboboxes, so I've got a sub for ComboBox1_DropButtonClick(), ComboBox2_DropButtonClick(), ComboBox3_DropButtonClick(), etc.. The code varies a bit, but it's repeatable. So it all looks rather dumb and I'm searching for some more ingenious solution. Maybe all those comboboxes can be scripted in one go? If there's any way to do it, please share it with me.
Thanks, Wojciech.
[edit] Location of my code (marked in grey):
Screenshot from VBA editor in VBA
Here is some code to dynamically add controls to an Excel Userform, and add the code behind. The code added will make it display a MessageBox when the ComboBox receives a KeyDown.
The code is somewhat commented, but let me know if you have questions :)
Option Explicit
Sub CreateFormComboBoxes(NumberOfComboBoxes As Long)
Dim frm As Object
Dim ComboBox As Object
Dim Code As String
Dim i As Long
'Make a blank form called 'UserForm1', or any name you want
'make sure it has no controls or any code in it
Set frm = ThisWorkbook.VBProject.VBComponents("UserForm1")
With frm
For i = 1 To NumberOfComboBoxes
Set ComboBox = .designer.Controls.Add("Forms.ComboBox.1")
'Set the properties of the new controls
With ComboBox
.Width = 100
.Height = 20
.Top = 20 + ((i - 1) * 40) 'Move the control down
.Left = 20
.Visible = True
.ZOrder (1)
.Name = "ComboBox" & i
End With
'Add your code for each module, you can add different code, by adding a if statement here
'And write the code depending on the name, index, or something else
Code = Code & vbNewLine & "Private Sub " & "ComboBox" & i & "_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & _
vbNewLine & " MsgBox(""hi"")" & vbNewLine & "End Sub"
Next
'Add the code
.CodeModule.InsertLines 2, Code
End With
End Sub
'Run this
Sub Example()
CreateFormComboBoxes 5
End Sub
**Edit**
I figured I might as well add the other approach for adding controls dynamically to an Excel sheet. I'd recommend sticking to UserForms, but, here's a method that should help out when controls are needed in a Sheet.
Sub addCombosToExcelSheet(MySheet As Worksheet, NumberOfComboBoxes As Long, StringRangeForDropDown As String)
Dim i As Long
Dim combo As Shape
Dim yPosition As Long
Dim Module As Object
yPosition = 20
For i = 1 To NumberOfComboBoxes
yPosition = (i - 1) * 50
'Create the shape
Set combo = MySheet.Shapes.AddFormControl(xlDropDown, 20, yPosition, 100, 20)
' Range where the values are stored for the dropDown
combo.ControlFormat.ListFillRange = StringRangeForDropDown
combo.Name = "Combo" & i
Code = "Sub Combo" & i & "_Change()" & vbNewLine & _
" MsgBox(""hi"")" & vbNewLine & _
"End Sub"
'Add the code
With ThisWorkbook
'Make sure Module2 Exits and there is no other code present in it
Set Module = .VBProject.VBComponents("Module2").CodeModule
Module.AddFromString (Code)
End With
'Associate the control with the action, don't include the () at the end!
combo.OnAction = "'" & ActiveWorkbook.Name & "'!Combo" & i & "_Change"
Next
End Sub
Sub Example()
Dim sht As Worksheet: Set sht = ThisWorkbook.Sheets(1)
addCombosToExcelSheet sht, 10, "Sheet1!$A$1:$A$10"
End Sub
I can't figure out what I'm doing wrong here. I added a button to an Excel Sheet programmatically. I am trying to assign an accelerator key, but it does not get assigned. The relevant code is:
Sub addPrint(sht, Optional fromLeft, Optional fromTop)
If IsMissing(fromLeft) Then fromLeft = 180
If IsMissing(fromTop) Then fromTop = 10
Set printbut = sht.Buttons.Add(fromLeft, fromTop, 50, 20)
printbut.Name = "PrintButton"
printbut.OnAction = "Sheet4.printButton"
printbut.Characters.Text = "Print/PDF"
printbut.Accelerator = "P"
End Sub
The 'P' does not get underlined and Alt-P does nothing.
This is the way to add an ActiveX-Button:
Sub addActiveXCommandButton(sht As Worksheet, Optional left As Single = 100, Optional top As Single = 100)
Dim btn As OLEObject
'
'create Button
'
Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, left:=left, top:=top, _
Width:=105.75, Height:=36)
Debug.Print TypeName(btn) ' this returns OLEObject as a wrapper of the CommandButton
Debug.Print TypeName(btn.Object) ' this returns CommandButton - the activeX-Object
'
' access the CommandButton-Object and set the Accelerator value
'
btn.Object.Accelerator = "B"
End Sub
However, I am not certain, that the Accelerator Button may be accessed. On testing, the Accelerator Button could bot be accessed using the Alt-key.
I use a solution with a button and an application.onKey-definition that both access the same procedure.
I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos")
What I want to do is have buttons (90, 180, 270) for rotating the images located in "C:\Temp\Photos". Thinking it may be an FileSystemObject but dont know enough about them yet to know how to do this.
EDIT: Added some code by request. Pictures are inserted depending on value selected in combobox. Any changes would reference pic1-pic5 (only ever 5 pics at any time).
Private Sub ComboBox1_Change()
pic1 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\1.jpg"
pic2 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\2.jpg"
pic3 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\3.jpg"
pic4 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\4.jpg"
pic5 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\5.jpg"
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else
Me.Image1.Picture = LoadPicture("")
End If
If Dir(pic2) <> vbNullString Then
Me.Image2.Picture = LoadPicture(pic2)
Else
Me.Image2.Picture = LoadPicture("")
End If
If Dir(pic3) <> vbNullString Then
Me.Image3.Picture = LoadPicture(pic3)
Else
Me.Image3.Picture = LoadPicture("")
End If
If Dir(pic4) <> vbNullString Then
Me.Image4.Picture = LoadPicture(pic4)
Else
Me.Image4.Picture = LoadPicture("")
End If
If Dir(pic5) <> vbNullString Then
Me.Image5.Picture = LoadPicture(pic5)
Else
Me.Image5.Picture = LoadPicture("")
End If
End Sub
Like I mentioned, there is no inbuilt way to rotate a picture in userform. Having said that, there is an alternative to achieve what you want. Below I have demonstrated on how to rotate the image 90 degrees.
Logic:
Insert a temp sheet
Insert the image into that sheet
Use IncrementRotation rotation property
Export the image to user's temp directory
Delete the temp sheet
Load the image back
Preparing your form
Create a userform and insert an image control and a command button. Your form might look like this. Set the Image Control's PictureSizeMode to fmPictureSizeModeStretch in the properties window.
Code:
I have written a sub RotatePic to which you can pass the degree. Like I mentioned that This example will rotate it 90 degrees as I am just demonstrating for 90. You can create extra buttons for rest of the degrees. I have also commented the code so you shouldn't have any problem understanding it. If you do then simply ask :)
Option Explicit
'~~> API to get the user's temp folder path
'~~> We will use this to store the rotated image
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim NewPath As String
'~~> Load the image on userform startup
Private Sub UserForm_Initialize()
Image1.Picture = LoadPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
End Sub
'~~> Rotating the image 90 degs
Private Sub CommandButton1_Click()
RotatePic 90
DoEvents
Image1.Picture = LoadPicture(NewPath)
End Sub
'~~> Rotating the image
Sub RotatePic(deg As Long)
Dim ws As Worksheet
Dim p As Object
Dim chrt As Chart
'~~> Adding a temp sheet
Set ws = ThisWorkbook.Sheets.Add
'~~> Insert the picture in the newly created worksheet
Set p = ws.Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
'~~> Rotate the pic
p.ShapeRange.IncrementRotation deg
'~~> Add a chart. This is required so that we can paste the picture in it
'~~> and export it as jpg
Set chrt = Charts.Add()
With ws
'~~> Move the chart to the newly created sheet
chrt.Location Where:=xlLocationAsObject, Name:=ws.Name
'~~> Resize the chart to match shapes picture. Notice that we are
'~~> setting chart's width as the pictures `height` becuse even when
'~~> the image is rotated, the Height and Width do not swap.
With .Shapes(2)
.Width = p.Height
.Height = p.Width
End With
.Shapes(p.Name).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
'~~> Temp path where we will save the pic
NewPath = TempPath & "NewFile.Jpg"
'~~> Export the image
.ChartObjects(1).Chart.Export Filename:=NewPath, FilterName:="jpg"
End With
'~~> Delete the temp sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub
'~~> Get the user's temp path
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
In Action
When you run the userform, the image is uploaded and when you click on the button, the image is rotated!
The only way I see of doing this would be to copy the picture into a chart, rotate it, export it, and re-open it inside the form the same way you are displaying pictures right now.
Try this.
Change
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else ...
To
If Dir(pic1) <> vbNullString Then
pic1 = myFunction(pic1, rotationDegree)
Me.Image1.Picture = LoadPicture(pic1)
Else ...
(And everywhere else this structure is used)
Insert, inside a module, the following function :
Public Function myFunction(myPicture As String, myRotation As Integer) As String
ActiveSheet.Pictures.Insert(myPicture).Select
Selection.ShapeRange.IncrementRotation myRotation
Selection.CopyPicture
tempPictureName = "C:\testPic.jpg"
'Change for the directory/filename you want to use
Set myChart = Charts.Add
myChart.Paste
myChart.Export Filename:=tempPictureName, Filtername:="JPG"
Application.DisplayAlerts = False
myChart.Delete
Selection.Delete
Application.DisplayAlerts = True
myFunction = myDestination
End Function
EDIT : Took so long to get the time to finish writing the post (from work) that I missed the other user's answer, which seems to use the same logic. However, my approach might be easier to use for you!
EDIT2 : rotationDegree needs to be set to the degree of the rotation (which needs to be determined before retrieving the picture).