I have created different shapes in excel and have assigned a macro to it which functions as activating another sheet. I want to put all these under one macro and then assign it to different shapes with different linking property. But this code doesn't work because obviously I am doing something stupid. Can someone please help?
Dim shp As ShapeRange, ws As Sheets, i As Integer
Set ws = ActiveWorkbook.Sheets(Array("Introduction", "S1 Fuel Consumption", "S1 Fugitive", "S2 Electricity Consumption"))
Set shp = ws(2).Shapes.Range(Array("Chevron1", "Chevron2"))
Select Case shp(i)
Case shp(1)
ws(1).Activate
Case shp(2)
ws(3).Activate
End Select
End Sub
There is a much easier way to do "buttons" in VBA (I assume this is what your trying to achieve)
First off, in a module, create the "Open Worksheet" code:
Sub Open_Sheet2
Sheets("Sheet2").visible = True
Sheets("Sheet2").Activate
End Sub
Then right click your shape, choose Assign Macro and assign Open_Sheet2 to that shape. Now when it is clicked, it will open Sheet2
Related
I am trying to show the filter columns to users in the report. Excel gives a different icon but for large no. columns it will be good to color the columns in another color like blue.
I found code at Is there a way to see which filters are active in Excel, other than just the funnel icons?
It works for me, but how do start this code without any button
SheetChange and selection change do not work.
code
Sub test()
Call markFilter(ActiveSheet)
End Sub
Sub markFilter(wks As Worksheet)
Dim lFilCol As Long
With wks
If .AutoFilterMode Then
For lFilCol = 1 To .AutoFilter.Filters.Count
'/ If filter is applied then mark the header as bold and font color as red
If .AutoFilter.Filters(lFilCol).On Then
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Color = vbRed
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Bold = True
Else
'/ No Filter. Column header font normal and black.
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Color = vbBlack
.AutoFilter.Range.Columns(lFilCol).Cells(1, 1).Font.Bold = False
End If
Next
Else
'/ No Filter at all. Column header font normal and black.
.UsedRange.Rows(1).Font.Color = vbBlack
.UsedRange.Rows(1).Font.Bold = False
End If
End With
End Sub
I will use the same example I used in the answer that you mentioned in your post. I answered that. :)
There is no filter change event in excel. One work-around that I would use is trapping the calculate method of the worksheet or better the workbook.
So, in the worksheet with filter add a dummy formula like this: =SUBTOTAL(3,Sheet2!$A$1:$A$100) this counts only visible cells. But its up to you. Feel free to use any formula that responds to filter change.
After that, go to workbook's code and add this :
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call markFilter(Sh)
MsgBox "Filter changed"
End Sub
Boom. Now you are trapping the filter change events and it will update the filtered columns by firing the vba code.
Note markFilter is coming from the answer that you mentioned.
The key points from my article Trapping a change to a filtered list with VBA
A "dummy" WorkSheet is added with a single SUBTOTAL formula in A1 pointing back to the range being filtered on the main sheet.
A Worksheet_Calculate() Event is added to the "dummy" WorkSheet, this Event fires when the SUBTOTAL formula updates when the filter is changed.
The next two steps are only needed if it is desired to run the Workbook Calculation as Manual
Add a Workbook_Open Event to set the EnableCalculation property of all sheets other than "Dummy" to False.
Run the Workbook in Calculation mode
I have added a rectangle shape to a spreadsheet. I now wish to use a macro on event RectangleA_Click(). I know the shape's name is RectangleA as I have the below sub:
Sub f()
Dim Shape As Shape
For Each Shape In ActiveSheet.Shapes
Debug.Print Shape.Name
Next
End Sub
I have written the code:
Private Sub RectangleA_Click()
MsgBox "hello"
End Sub
In the relevant sheet object space in the editor. On clicking the shape the subroutine is not called.
I am aware that I can assign this using right click> assign macro, but would prefer to avoid this as it seems like an unnecessary step. I'm also aware that there are Active X controls which automatically assign the macro, again I would prefer to avoid this if possible.
Something like this may work:
Sub AssignMacroToShape()
Set shpTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1680#, 594#, 120#, 74.25)
shpTemp.OnAction = ActiveWorkbook.Name & "!Macro Name"
End Sub
But it will be much easier just to right click > Assign Macro.
This above code is useful if you need to create the shape then assign a macro to it after creation.
You can look into the OnAction event to get the answer to specifics if this doesn't help.
I have this Problem for deleting a shape in Excel with vba. Excel gives all the time different Name to These shapes, thatswhy i get error on this line:Here Activesheet is my open sheet and straight connectgor 1 is the Name of the shape, it is set as "Straight Connector 1" but when i reuse the macro it can not be found.
ActiveSheet.Shapes.Range(Array("Straight Connector 1")).Select
Selection.Delete
It can not find the element if i use the macro again. What should i do for this ?
use the activtsheet.shapes collection
Sub connector_delete()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.AutoShapeType = msoShapeMixed And s.Name Like "*Connector*" Then
s.Delete
End If
Next s
End Sub
Platform : MS Excel 2007(MS Visual Basic 6.0)
I have a few excel file with different textboxes in them.
All the textboxes were name. E.g TxTbox_AAAA, TxtBox_BBBB
Most of them have similar number of Textboxes with same name.
I also required to update the content inside the textboxes. But like i said... some excel file doesn't contain the textboxes.
E.g aaa.xls and bbb.xls have TexTbox_AAAA, TextBox_BBBB
and ccc.xls only have TexTbox_AAAA
my script is something like this
xlApp.ActiveSheet.TextBoxes("TextBox_AAAA").Text = TxtAAAA
xlApp.ActiveSheet.TextBoxes("TextBox_BBBB").Text = TxtBBBB
but if i run, it will encounter run-time error '1004':
Unable to get the TextBoxes property of the Worksheet class
which i suspect it is due to the excel doesn't have this textbox named "TextBox_BBBB"
so how do i put a check before xlApp.ActiveSheet.TextBoxes("TextBox_BBBB").Text = TxtBBBB
to check if this worksheet/activesheet doesn't contain TextBoxes("TextBox_BBBB"), it will not execute this step?
Since a TextBox is a Shape, here is one way to tell if a specific TextBox is on the activesheet:
Public Function IsItThere(sIn As String) As Boolean
IsItThere = False
If ActiveSheet.Shapes.Count = 0 Then Exit Function
For Each s In ActiveSheet.Shapes
If s.Name = sIn Then
IsItThere = True
Exit Function
End If
Next s
End Function
Not sure but try this:
Dim ws as Worksheet
Dim shp as Shape
Set ws = Activesheet '~~> change to suit
For Each shp in ws.Shapes
If shp.Name = "Textbox_Name" Then
'~~> your code here
End If
Next
Hope this helps
Thanks L42 and Gary's Student
I got it.. i should put
For Each s In xlApp.ActiveSheet.Shapes
instead of
For Each s In ActiveSheet.Shapes
only
Thanks for the help!!! =)
I am working on a Excel Spreadsheet that when a dropdown box value is selected an image will pop up, and if another value is selected it will hide the current image and pop up the image related to the selection. I have found a few methods that are just too time consuming using just the sheet and positioning of the image using coordinates; that's not exactly the route I would like to go.I have done a quite a bit of research before using StackOverflow, and nothing seemed to work thus far. Below is what I am trying to achieve. I am trying to keep all the images within the spreadsheet which adds another level of challenge, but I believe there is a way to do this because excel assigns the image a number when inserted EX. Picture 9.
Sub Main()
If Range(G11).Value = "anything" Then
Picture1 show
Picture2 hide
End If
End Sub
Any Help is greatly appreciated. Thanks
Rather than hiding/moving/reducing the size of the unwanted pic, why not simply delete it?
Logic:
Save all your images in a temp sheet. When ever a relevant picture is supposed to be shown, get it from the temp sheet and delete the previous.
Here is an example.
Sub Sample()
Select Case Range("G11").Value
Case "Picture 1": ShowPicture ("Picture 1")
Case "Picture 2": ShowPicture ("Picture 2")
Case "Picture 3": ShowPicture ("Picture 3")
Case "Picture 4": ShowPicture ("Picture 4")
End Select
End Sub
Sub ShowPicture(picname As String)
'~~> The reason why I am using OERN is because it is much simpler
'~~> than looping all shapes and then deleting them. There could be
'~~> charts, command buttons and other shapes. I will have to write
'~~> extra validation code so that those shapes are not deleted.
On Error Resume Next
Sheets("Sheet1").Shapes("Picture 1").Delete
Sheets("Sheet1").Shapes("Picture 2").Delete
Sheets("Sheet1").Shapes("Picture 3").Delete
Sheets("Sheet1").Shapes("Picture 4").Delete
On Error GoTo 0
Sheets("Temp").Shapes(picname).Copy
'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Sheet1").Range("G15").Select
Sheets("Sheet1").Paste
End Sub
Snapshot of temp sheet
Here is a solution using the Visible property of the object.
I used this to show a picture based on a value in a field.
The field had a formula that resulted in either "good" or "bad".
If its value was "good", I wanted to show one picture; for "bad", another picture should show; and they should never show at the same time.
The field needed to update its value whenever a user refreshed a pivot table, so I put the code in that method of the worksheet where the pivot table and picture were to appear.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'hide both pictures by loopng through all the shapes on the sheet
Dim s As Shape
For Each s In ActiveSheet.Shapes
'hide the shape if it is a picture, leave other shapes on the page visible.
If s.Type = msoPicture Then s.Visible = msoFalse
Next
Dim judgement As String
'The field whose value tells what picture to use is a one-cell named range called "judgement"
judgement = Range("judgement")
'you need to know which picture is which.
If judgement = "Good" Then ActiveSheet.Shapes("Picture 8").Visible = True
If judgement = "Bad" Then ActiveSheet.Shapes("Picture 1").Visible = True
End Sub
Sub hidePicture(myImage)
ActiveSheet.Shapes.Range(Array(myImage)).Select
Selection.ShapeRange.Height = 0
Selection.ShapeRange.Width = 0
End Sub
Sub showPicture(myImage)
ActiveSheet.Shapes.Range(Array(myImage)).Select
Selection.ShapeRange.Height = 200
Selection.ShapeRange.Width = 300
End Sub
Handy tip: record macro and look at the code it generates!
Might be better just to move your pictures "off screen", particularly if they're of different sizes.
Sub Tester()
ShowPicture "Picture 3"
End Sub
Sub ShowPicture(PicName As String)
Dim s As Shape
For Each s In ActiveSheet.Shapes
With s
.Top = IIf(.Name = PicName, 100, 100)
.Left = IIf(.Name = PicName, 100, 1000)
End With
Next s
End Sub