I'm trying to get a cell to show the height of a shape after the shape height changes when dragging the shape handle. I can successfully do this with an event handler but that requires deselecting the shape. Is it possible to show the new height of the shape in a cell without deselecting the shape? Thanks in advance.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim heightVar As Integer
heightVar = Sheets("Sheet1").Shapes.Range(Array("boxbox1")).Height
Sheets("Sheet1").Range("B1") = heightVar
End Sub
I place a TextBox on my sheet. I make sure cells A1 and A2 are empty. I run the following macro:
Sub dural()
Dim s As Shape
Set s = ActiveSheet.Shapes("TextBox 1")
While Range("A1") = ""
Range("A2") = s.Height
DoEvents
Wend
End Sub
If you select the Shape and change its height, cell A2 will respond.
To stop the macro from looping, just put something in cell A1.
Related
I have been looking in to adding buttons to a column so I can add specific rows of data to another sheet. It seems like you can't add buttons to cells so I have made my column cells look like buttons through formatting and then added a click function to determine if the row is clicked. This works but I'm starting to think it'll be better if the user selects which rows they want first clicks a single button to the right of the table to take all the rows out and add them to the other sheet.
Looking at radio buttons it seems like they too can't be embedded into a column but linked to a particular cell such that when they are clicked it can trigger data to a cell. They also seem like they can't be de-clicked either.
Is there something that can sit in a cell that when clicked will set it to say 1 ("Add to Sheet") and clicked again will set it to 0 ("Don't add")? Which I can then read in to a function to determine which rows should be added to the other sheet.
The easiest way is to add a column where the user puts in an X (or a blank). You can put an validation rule to that column so that only X is allowed if you want.
Unfortunately there is no Click-Event for a cell so that you can react on a click to toggle the X, best bet is the double-click (Worksheet_BeforeDoubleClick), so instead of entering the X by keyboard, the user can also double click on the cell:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then ' Assuming your selection column is [A]
Target.Value = IIf(Target.Value = "", "X", "")
End If
End Sub
If you think that this is too complicated for the user, you can put a control (like a checkbox) in every cell. However, you will either have to create those controls manually one by one or by code. You need to understand that all objects like controls, shapes, images, charts (and so on) are separate objects and they are not linked to a cell. You cannot access a shape with a property like Range("A1").shape, the shapes are only linked to the worksheet.
To force Excel to move a shape when a cell is resized, you need to set the property "Move with cells" so that when rows or columns are resized, the shape stays within the cell. But again, the control is not linked to the cell, Excel just moves its position (left and top property).
I am not a big fan of controls on a sheet, and I will not start to discuss the pros and cons of form controls vs ActiveX controls. If I need something like a button, I usually "misuse" a simple shape for that - every shape has a OnClick-method that is called when the shape is clicked.
The following piece of code places a rectangle shape inside a cell that bacically serves to catch the mouse click. I named those shapes "XShape" because they are used to set an X into a cell. The complete shape name contains also the row and column. The routine first checks if a shape with that name already exists - if yes, no new shape is created.
Sub AddShape(c As Range)
Const XShapeName_Prefix = "XShape_"
Const DeltaX = 2
Const DeltaY = 1
Dim ws As Worksheet, sh As Shape
Set ws = c.Worksheet
Dim shapeName As String
shapeName = XShapeName_Prefix & c.row & "_" & c.Column
' Check if shape is already there
On Error Resume Next
Set sh = ws.Shapes(shapeName)
On Error GoTo 0
If Not sh Is Nothing Then Exit Sub ' Shape already there
Set sh = ws.Shapes.AddShape(msoShapeRectangle, c.Left + DeltaX, c.Top + DeltaY, c.Width - 2 * DeltaX, c.Height - 2 * DeltaY)
sh.Fill.Visible = msoFalse
sh.Line.Visible = msoTrue
sh.Line.Weight = 0.75
sh.Line.ForeColor.RGB = vbBlack
sh.Name = shapeName
sh.OnAction = "XShape_Clicked"
End Sub
(Hint: If you set the ForeColor to vbWhite, the shape is invisible but still catches the mouse click)
As you can see, the OnAction-method is set to a subroutine XShape_Clicked. You can use the same routine for any number of shapes, the routine figures out which shape was clicked by using Application.Caller. It writes an "X" (or blank) into the underlying cell. Just format the cell so that the X is displayed inside the shape.
Sub XShape_Clicked()
Dim sh As Shape
On Error Resume Next
Set sh = ActiveSheet.Shapes(Application.Caller)
On Error GoTo 0
If sh Is Nothing Then Exit Sub
Dim cell As Range
Set cell = sh.TopLeftCell
If cell Is Nothing Then Exit Sub
cell.Value = IIf(UCase(cell.Value) = "X", "", "X")
End Sub
Now all you need is a small routine that puts a shape in every row of your data:
Sub AddShapesToColumn()
Dim row As Long, lastRow As Long
With ActiveSheet ' Replace this with the sheet you want to use
lastRow = .Cells(.Rows.Count, "B").End(xlUp).row
For row = 2 To lastRow
AddShape .Cells(row, "A")
Next row
End With
End Sub
You can call this routine whenever needed - eg if a new row is created, it will create new shapes only for the new rows.
In the code below that i got working, when i select a cell in a range, an input box pops up and my input is sent to the same cell i clicked but in sheet 2. I want to take this one step further. i want to bypass the input box completely and just send the value F, and i only want to do this after i click cell b2. so cell b2 would have to work as some kind of toggle (maybe put an invisible shape over it to act as a button?)
Example 1: sheet 1, select cell B2 turns on macro, select cell in range example: D10 inputs the letter F into cell D10 on sheet 2, select cell B2 turns off macro so if i select cell D10 or any cell in that range nothing will happen anymore. it would also need to remove the value F from D10 if the cell is clicked again while the macro is on.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRtn As Variant
If Selection.Count = 1 Then
If Not Intersect(Target, Range("D9:AS20")) Is Nothing Then
xRtn = Application.InputBox("Insert your value please")
Sheets("2020").Range(Target.Address).Value = xRtn
End If
End If
End Sub
Untested. I'm not sure if I understood all of your objectives.
I think if you add a checkbox to your worksheet (resize and store it wherever you want; maybe in cell B2) called "Check Box 1" then the below code should work.
One way of adding a check box might be: Excel > Developer > Insert > Check Box (Form Control) (depending on your Excel version). If the Developer tab is not visible, you may need to get it to show first.
Option Explicit
Private Function GetCheckBox() As Shape
Set GetCheckBox = Me.Shapes("Check Box 1")
End Function
Private Function IsCheckBoxTicked() As Boolean
IsCheckBoxTicked = (GetCheckBox.OLEFormat.Object.Value = 1)
End Function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
If Intersect(Target, Me.Range("D9:AS20")) Is Nothing Then Exit Sub
If IsCheckBoxTicked() Then
With ThisWorkbook.Worksheets("2020").Range(Target.Address)
.Value = IIf(.Value = "F", Empty, "F")
End With
End If
End Sub
I have rows from 1-100.
I know how to target specific cells and get data from them, but how would I do this when any row from 1 to 100 can be changed?
Say you put anything into Row A3. How would you write "Updated" into row B3 via VBA?
I want this to apply to rows A1-A100.
Thanks
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Intersection As Range, Cell As Range
Set A = Range("A1:A100")
Set Intersection = Intersect(Target, A)
If Intersection Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Intersection
Cell.Offset(0, 1).Value = "Updated"
Next Cell
Application.EnableEvents = True
End Sub
Open VBA Editor
Double click on the sheet you event take action (sheets appears in the left top box)
Select Worksheet on the left box above code box
Select change on the right box above code box
Paste the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, .Range("A1:A100")) Is Nothing Then
Application.EnableEvents = False
.Range("B" & Target.Row).Value = "Updated"
Application.EnableEvents = True
End If
End With
End Sub
Show Shapes Based on Cell Value
I want to show and hide shapes on a sheet based on the cell value >1. If cell A1 = 1 the shape should be visible and for value is 0, the shape should be hidden. i need the code for compelete my job,
The following Private Sub should work whether the cell value changes manually or as a result of a formula. It assumes cell A1 contains the test value, and simply add the name of your shape to make it work:
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Range("A1") = 1 Then
Me.Shapes("Shape Name").Visible = True
Else
If ActiveSheet.Range("A1") = 0 Then
Me.Shapes("Shape Name").Visible = False
End If
End If
End Sub
I am looking for some code that will change the colour of a shape when a cell is clicked on.
Example the shape is S_IRL which is Ireland and is located in Cell B22.
What I would like to happen is that if Cell B22 then shape S_IRL changes from Blue to Red. Then if another cell with a country is clicked then the corresponding shape changes to red and the previous returns to it previous colour.
Any help would be greatly appreciated
You can add a new subroutine in the worksheet's code that will fire when the selection changes on the sheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strShapeName As String 'Variable to hold the shape name
Dim shp As Shape 'Variable to hold a shape object
'Detect if the click was in range A:C
If Not Intersect(Target, Range("A:C")) Is Nothing Then
'Boom... set all the shapes to blue
For Each shp In Me.Shapes
If Left(shp.Name, 2) = "S_" Then shp.Fill.ForeColor.RGB = RGB(0, 0, 255)
Next shp
'Grab the shape name from Column A
strShapeName = Cells(Target.Row, 1).Value
'Set the color of the shape to red
Shapes(strShapeName).Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
End Sub
This will detect if the selection change was to a cell in columns A, B, or C. If it was it will grab the name of the shape from Column A and then set the color of that shape to red.