My code isn't working to modify shape visability ... can you help?
Have named a cell [test] and want a line callout shape to appear/ disappear based on a value in a cell. 1 = visable 0= not visable
Sub Macro1()
Dim ws As Worksheet
With ws.Shapes.Range(Array("Line Callout 1 1"))
.Fill.Visible = [test]
.Line.Visible = [test]
End With
End Sub
Try this
Sub Macro1()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.Shapes.Range(Array("Line Callout 1 1"))
.Fill.Visible = Range("test")
.Line.Visible = Range("test")
End With
End Sub
Related
i have a graph multiples graph on a sheet that when i change values sometimes the label of the graph does not show. how can i create a macro that reset label text for the chart. i tried to record a macro but will only update one legend but not all of the labels that i have.enter image description here
Sub Macro1()
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
ActiveChart.ApplyDataLabels
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.AutoText = True
End Sub
Here's a quick example on how you can apply data labels (and even how to position the labels) on any given chart:
Option Explicit
Sub test()
Dim ws As Worksheet
Set ws = Sheet1
Dim chartObj As ChartObject
For Each chartObj In ws.ChartObjects
ShowDataLabels chartObj.Chart
Next chartObj
End Sub
Sub ShowDataLabels(ByRef theChart As Chart, _
Optional ByVal show As Boolean = True)
With theChart
Dim i As Long
For i = 1 To .SeriesCollection.Count
With .SeriesCollection(i)
.HasDataLabels = True
.DataLabels.ShowValue = True
.DataLabels.Position = xlLabelPositionAbove
End With
Next i
End With
End Sub
I have this macro that creates a textbox in worksheet 2 when I write something in cell A1 of worksheet 1, and when I delete that value it deletes the textbox.
I want to do that for several cells, but it just is working. If Cell A1 has a value a textbox with that value should appear, if the A2 has a value a textbox with that value should appear, but if I delete A1 it should delete the texbox that refers to A1, not all of the textboxes
Sub RemoveShapes()
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub
Sub criarcaixastexto()
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Range("Folha1!A1").value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Call criarcaixastexto
End If
End Sub
I tried this but it doesn't work
'macro para apagar
Sub removercaixas()
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub
'macro para criar caixas de texto
Sub criarcaixastexto()
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Cells(i, 1).Value
End Sub
' macro corre ao escrever texto numa célula
Private Sub Worksheet_Change(ByVal Target As Range)
For i = 1 To 3
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A&i")) Is Nothing Then
removercaixas
If Len(Target) > 1 Then criarcaixastexto
End If
Next
End Sub
You are removing all textboxes on the sheet any time you call removercaixas. You need to somehow link the textbox with the cell it was generated by.
Why not name the textbox with the cell address? Copy/Paste this:
Sub removercaixas(strName As String)
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox AND shp.Name = strName Then shp.Delete
Next shp
End Sub
And
Sub criarcaixastexto(strName As String)
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Worksheets(1).Range(strName).Value
box.Name = strName
End Sub
And
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case Target.Address
Case "$A$1", "$A$2", "$A$3"
removercaixas (Target.Address)
Case Else
Exit Sub
End Select
If Len(Target) > 1 Then criarcaixastexto (Target.Address)
End Sub
Textboxes are created in worksheet 2 all on top of each other. They are deleted appropriately. No textbox is created when the value entered in $A$1:$A$3 has a length of 1 or less. Not sure what the logic is there, but if you want single digit values to create a textbox just change the Len(Target) > 1 to Len(Target) > 0.
Am trying to hide or move a series of shapes in excel.
I have a range of cells that I want to copy as a picture and basically if the shape isn't 'active' i.e. contains text then I don't want the shapes to be visable in this range of cells. Each shape is linked and if the if/vlookup is true the shape will contain text.
The following is not working - have tried modifying .Visable with .Right i.e. to shift the shapes out of range - but it says object does not support this property or method.
Sub Macro3()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
Dim shp As Shape
Dim tr As TextRange2
Dim grp As Shape
Dim sShape As Shape
Set shp = ws.Shapes("Line Callout 1 2")
Set tr = shp.TextFrame2.TextRange
For Each ws In ThisWorkbook.Worksheets
For Each shp In ws
If shp.Name Like "Line Callout 1" And tr.Characters.Text = "" Then
sShape.Right = 300
Else
sShape.Right = 0
End If
Next shp
Next ws
End Sub
If I specify a named cell I can alter the visability but for over 600 shapes I want to auomate this somehow This works for named shape and named range:
Sub Macro1()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.Shapes.Range(Array("Line Callout 1 1"))
.Fill.Visible = Range("x")
.Line.Visible = Range("x")
End With
End Sub
I am trying to add a button to an Excel workbook so that it shows up in every sheet. A great answer to my original question gave me a macro to create the buttons on each sheet:
Sub AddButtons()
Dim ws As Excel.Worksheet
Dim btn As Button
For Each ws In ThisWorkbook.Worksheets
Set btn = ws.Buttons.Add(X, Y, W, H)
[set btn properties]
Next ws
End Sub
I am now having trouble with setting the button properties so that the button prints the sheet when pressed. Again here is my print macro:
Dim WS_Count As Integer
Dim i As Integer
' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
'allows user to set printer they want to use
Application.Dialogs(xlDialogPrinterSetup).Show
' Begin the loop.
For i = 5 To WS_Count
Worksheets(i).Activate
With ActiveWorkbook.Worksheets(i).PageSetup
.PrintArea = "A1:O48"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
ActiveWorkbook.Worksheets(i).PrintOut
There have been some good suggestions about how to go about incorporating this macro into the button properties (passing variables and creating a new print sub) however I am pretty new to VBA and have been unsuccessful in getting this to work. Ideally I would have a button macro that creates the button and every time it is pressed calls the print macro for each sheet.
One last thing, I am trying to change the button code so that it only adds buttons to sheet 5 onwards. It would be great if anyone knew how to do that as well?
Any advice is helpful and greatly appreciated!
Try this:
Sub AddButtons()
Dim ws As Excel.Worksheet
Dim btn As Button
For Each ws In ThisWorkbook.Worksheets
Set btn = ws.Buttons.Add(X, Y, W, H)
btn.OnAction = "MySub" ' MySub is executed when btn is clicked
' Substitute the name of your printing subroutine
btn.Caption = "Print"
'set additional btn properties as needed
Next ws
End Sub
X and Y determine the location, W and H determine the button size.
This will add a button (Form Control) and assign an existing macro to it.
Sub test()
Dim cb As Shape
Set cb = Sheet1.Shapes.AddFormControl(xlButtonControl, 10, 10, 100, 25)
cb.OnAction = "PrintMacro"
End Sub
Private Sub PrintMacro()
MsgBox "Test" ' for testing pursposes
' you actually put your print code here
End Sub
Now to add buttons from Sheet 5 onwards only, you can try:
Producing a list of all your sheet names (if there's only a few of them)
Dim shname
For Each shname In Array("Sheet 5", "Sheet 6", "Sheet 7")
test Sheets(shname) ' note that you'll have to use below test sub
Next
Do it the other way around. Make a list of what to exclude and test every sheet if it is on the list or not.
Dim sh As Worksheet
Dim xcludesheet: xcludesheet = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
For Each sh In Worksheets
If IsError(Application.Match(sh.Name, xcludesheet, 0)) Then
test Sheets(sh.Name)
End If
Next
Your test sub to be used in above samples.
Sub test(ws As Worksheet)
Dim cb As Shape
Set cb = ws.Shapes.AddFormControl(xlButtonControl, 10, 10, 100, 25)
cb.OnAction = "PrintMacro"
End Sub
I'd like to change the values of a chart axis autumatically with macro from a cell. I can get it to work, if the command button and chart are on the same sheet. But I'd like to change it on chart, that is not in a normal sheet, but in a "chart sheet", so reference to is a little bit different. Does anyone now how?
Sub ChangeAxisScale()
With ActiveSheet.ChartObjects("chart21").Chart
With .Axes(xlValue)
.MaximumScale = ActiveSheet.Range("Axis_max").Value
.MinimumScale = ActiveSheet.Range("Axis_min").Value
.MajorUnit = ActiveSheet.Range("Unit").Value
End With
End With
End Sub
You have to use appropriate references. For example (Untested)
Sub ChangeAxisScale()
Dim wsChart As Chart
Dim wsInput As Worksheet
'~~> Change the below as applicable
Set wsChart = Chart1 '<~~ Code name of the chart sheet
Set wsInput = ThisWorkbook.Sheets("Sheet1") '<~~ Name of sheet with data
With wsChart
With .Axes(xlValue)
.MaximumScale = wsInput.Range("Axis_max").Value
.MinimumScale = wsInput.Range("Axis_min").Value
.MajorUnit = wsInput.Range("Unit").Value
End With
End With
End Sub