I am struggling to even figure out where to start here, so any push in the right direction will be of great help.
I have a map spreadsheet with many different rectangle objects that contain text. When I click on a Rectangle I want to run a macro and I want that macro to receive the text in the rectangle as a parameter. The goal is to get this to display a userform complete with a listbox table that would be custom created based off of the text in the rectangle. I know how to do the latter, but I'm blanking on how to get this property from a shape object. I figured it would be something like this?
Sub Rectangle205_Click()
facilityName = Me.Text
End Sub
or
Sub AMacro(By Ref Target)
facilityName = Target.Text
End Sub
I am pretty clueless on this one, so your help is appreciated.
You could use first code below to link every shapes in a specific sheet to the get_text code:
Sub apply_script()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.OnAction = "get_text"
Next
End Sub
Then use this code to get the text of the shape:
Sub get_text()
MsgBox ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Caption
End Sub
Edit for rectangles only :
Sub apply_script()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.AutoShapeType = 1 Then
sh.OnAction = "get_text"
End If
Next
End Sub
Related
I am currently working on an Excel tool that I have equipped with one button and one shape-object.
The button is a select button to "select" the shape object. The idea is to Select a shape-object a Picture and change its color after selecting it.
I was able to locate the problem to the clicked Sub of the Select button.
To check if I'm correct I have written a the Macro Select_MyClicked and afterword used the call instruction to invoke the macro from within the Clicked-function of the select button.
Sub Select_MyClicked()
Dim ElementName As String
Dim Shp As Object
Set Shp = Sheets("Tabelle1").Shapes(ElementName)
Shp.Select
End Sub
==================================================================
Private Sub CommandButton3_Click()
Call Select_MyClicked
End Sub
==================================================================
What is interesting now is:
When I use the Button the Image is selected but in the Picture format register there i nothing selectable
If I cklick on the Image itselfe or use the Select_MyClicked Macro indepentently everything in the picture format register is selectable
I also tried to write the select instruction directly into the Button-Clicked private sub. Same result nothing selectable
What I want to do is select an image and change its color. My second question is does somebody know how to open the Colorpennel (with the many colored Rectangles) using vba ?
You need to reference the Shape by its Name. I assigned the name "myshape" to the Shape before running:
Sub Select_MyClicked()
Dim ElementName As String
Dim Shp As Shape
ElementName = "myshape"
Set Shp = Sheets("Tabelle1").Shapes(ElementName)
Shp.Select
End Sub
The code runs even if Tabelle1 is not the active sheet.
I have finally find the solution. It seems like it makes a difference which button you use. In my case it had to be the control elements not the activeX elements
Apologies another noob question. I have been tasked with writing a document within excel, the front cover has a lot of images on it and i have grouped these images together. As there is a risk that the user could move this group. I want to set it so each time that sheet is selected it moves back to its original location. I have looked over the web and i can't seem to find anything for a group of images.
I have tried this and it doesnt work at all. :(
Private Sub Worksheet_Activate()
Dim PicGroup As GroupShapes
With Range("A1")
PicGroup.Name = "HeaderGrp"
PicGroup.Visible = True
PicGroup.Top = .Top
PicGroup.Left = .Left
End With
End Sub
So my group of images I have called HeaderGrp I have put this on Activate Worksheet in VBA and i want this to always move or fix to cells A1.
I would also love this to fit to the page width and length if anyone knows how to do that.
Snapshot of what i would like: -
1) on sheet selection, image group moves to the correct location.
2) image group auto adjusts to page width and height.
Thank you in advance,
This works for me. Pictures appear to be treated as a type of Shape.
Private Sub Worksheet_Activate()
Dim p As Shape
With activesheet
Set p = .Shapes("Pics") 'name
p.Top = .Range("a1").Top
p.Left = .Range("a1").Left
End With
End Sub
This piece of code should get your grouped images:
Option Explicit
Private Sub Worksheet_Activate()
Dim shp As Shape
Dim PicGroup As GroupShapes
'loop through all your shapes
For Each shp In Me.Shapes
'if the shape is grouped then
'set your PicGroup variable
'and exit the loop
If shp.Type = msoGroup Then
Set PicGroup = shp.GroupItems
Exit For
End If
Next shp
With Range("A1")
PicGroup.Name = "HeaderGrp"
PicGroup.Visible = True
PicGroup.Top = .Top
PicGroup.Left = .Left
End With
End Sub
I am new to VBA. i have few shapes in a worksheet.
I want to get the name of shape to appear in combobox and character name in another Combobox, when any particular shape is selected. so i can rename that shape and link to particular excel column.
i have tried following.
With Selection
ActiveSheet.ComboBox1.Value = ActiveSheet.Shapes(Application.Caller).Name
End with
Not sure where to assign above code.
I tried assigning above code to a shape with .onaction as macro, it work but a marco assiged shape cannot be edited further(For design purpose).
Also It would be great if i can delete selected shape.
Thank you in advance.
You can use your code for any shape and you can change the code whenever you want, but assigning a macro, she shape will will not be selected when clicked... It becomes a kind of control.
Excepting the case when you force it to select:
Debug.Print ActiveSheet.Shapes(Application.Caller).Name
shW.ComboBox1.value.Shapes(Application.Caller).Select
You can change the code from right click context (on the chart bottom side) and choose 'Assign Macro... -> Edit'.
You can find the selected shape using the next code:
Sub testSelectedShape()
Dim shW As Worksheet, sh As Object, selSh As Object
Set shW = ActiveSheet
If TypeName(Selection) <> "Range" Then
Set selSh = Selection
Set sh = shW.Shapes(selSh.Name)
Debug.Print selSh.Name
shW.ComboBox1.value = selSh.Name
End If
End Sub
You can delete it simple using sh.Delete...
I'm trying to use VBA in Excel to convert a bunch of pictures in a column (one per cell) to a pop up comment image instead so that the sheet is more easily readable.
I can find the image I need by iterating through the shapes, and I can set this as an object; but I can't seem to use that onject to populate the comment field. It seems to be looking for a true file path instead.
I don't particularly want to have to save each image and then reload it, seems kind of pointless.
For Each Pic In ActiveSheet.Shapes
If Pic.TopLeftCell.Address = ActiveCell.Address Then
If Pic.Type = msoPicture Then
Pic.Select
Application.ActiveCell.AddComment.Shape.Fill.UserPicture **(ActiveSheet.Shapes(Pic.name))** 'if I use a path here its okay
'SelectPictureAtActiveCell = name
Exit For
End If
End If
Next
any thoughts?
CJ
I think you want to show one image if you select a specific cell then
See
Making shapes invisible/visible in excel through VBA
with
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Macro1
End Sub
You can make images hide and show using
ActiveSheet.Shapes("ImageName").Visible = False or True
for example when you click on cell A1 first image is hidden else all images are visible
Sub Macro1()
Dim shp As Shape
If ActiveCell.Address = "$A$1" Then
For Each shp In ActiveSheet.Shapes
ActiveSheet.Shapes(1).Visible = False
' or you can use image name as
'ActiveSheet.Shapes("ImageName").Visible = False
'shp.Visible = False
Next
Else
For Each shp In ActiveSheet.Shapes
shp.Visible = True
Next
End If
End Sub
I have a worksheet that runs a weightlifting meet. Last year I had created a tab that would give information on the current lifter and on who was lifting next.
left side - Display, right side - input tab
When I input an "x" in columns R, S, T, or W on the data tab, it changes the information in the BenchGenerator tab, like so:
Updated Display tab
What I want to do is make a userform display to run on a different screen so people can see this information. I had accomplished this last year by widening excel and using two view windows - display on the second screen and running the meet on the computer. It was ok but very clunky looking. With a floating userform tab, it would look fantastic. I am new to this, but got the form floating:
Private Sub Worksheet_Change(ByVal Target As Range)
UserForm1.Show (vbModeless)
End Sub
And got the labels to initially populate:
Userform Display
Using this code:
Private Sub UserForm_Activate()
UserForm1.Label1.Caption = Sheets("BenchGenerator").Range("c4").Value
UserForm1.Label2.Caption = Sheets("BenchGenerator").Range("c5").Value
UserForm1.Label3.Caption = Sheets("BenchGenerator").Range("c6").Value
UserForm1.Label4.Caption = Sheets("BenchGenerator").Range("d3").Value
UserForm1.Label5.Caption = Sheets("BenchGenerator").Range("d4").Value
UserForm1.Label6.Caption = Sheets("BenchGenerator").Range("d5").Value
UserForm1.Label7.Caption = Sheets("BenchGenerator").Range("d6").Value
End Sub
What it doesn't currently do is update the captions when I input the "x" in the data tab.
As I mentioned, this is my first foray into userforms and looking through mountains of code trying to figure this out, it will not be my last as there is lots to accomplish with them.
Thanks in advance for any help!
You're pretty close to getting this to work. The problem is that your calling a new form every time a change occurs.
Declare your form as an object outside of the Sub that creates (Show) it.
You can then access it to update labels from another Sub that has the same scope.
Create an UpdateForm sub for example and call it from your Worksheet_Change event.
Try this, place the following code in a new Module:
Dim myForm As Object
Sub launchForm()
Set myForm = UserForm1
myForm.Show (vbModeless)
End Sub
Sub updateForm()
Dim wks As Worksheet
Set wks = Sheets("BenchGenerator")
'Update label values here
myForm.Label1.Caption = wks.Range("C4").Value
myForm.Label2.Caption = wks.Range("C5").Value
myForm.Label3.Caption = wks.Range("C6").Value
myForm.Label4.Caption = wks.Range("D3").Value
myForm.Label5.Caption = wks.Range("D4").Value
myForm.Label6.Caption = wks.Range("D5").Value
myForm.Label7.Caption = wks.Range("D6").Value
End Sub
If you use Worksheet_Change to update the form you'll want to verify the form exist or just skip any errors in the event if it doesn't.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
updateForm
End Sub
Not sure if there is an easier way to do it, but I made a concatenation routine to batch out my label setup and updates to quickly create/copy/paste all the code.
Just in case anyone didn't know how to do this