I am simply trying to create a rectangle shape in a specific worksheet, formatting it & assign a macro to it using VBA.
Here goes my attempt :
Set t = wsJTO.Range("H" & 5 & ":G" & 6)
Set btn = wsJTO.Shapes.AddShape(msoShapeRectangle, t.Left, t.Top, t.Width, t.Height)
With btn.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
.Solid
End With
With btn.ShapeRange.ThreeD
.BevelTopType = msoBevelArtDeco
.BevelTopInset = 9
.BevelTopDepth = 6
End With
btn.OnAction = "Module2.Selection_JTO"
According to the debugger, there is an error with the third line & I don't seem to understand what's wrong with it. Help would be appreciated
Silly me ... All I had to do was get rid of "ShapeRange" since it doesn't have a fill property. The following code does the job if it might serve someone in the future :
Set t = wsJTO.Range("H" & 5 & ":G" & 6)
Set btn = wsJTO.Shapes.AddShape(msoShapeRectangle, t.Left, t.Top, t.Width, t.Height)
With btn.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(146, 208, 80)
.Transparency = 0
.Solid
End With
With btn.ThreeD
.BevelTopType = msoBevelArtDeco
.BevelTopInset = 9
.BevelTopDepth = 6
End With
btn.OnAction = "Module2.Selection_JTO"
Related
I'be built a code for a calendar-type plan with textboxes and pictures. I've managed to make a code so the shapes are all placed on the right spot. However, I'm struggling to copy some pictures from one sheet to another.
Sub AddEvent2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim i As Integer, shp As Shape, s, s2, v, t1, t2, t3, h, p, w, rgb1, rgbULP, rgbPULP, rgbSPULP, rgbXLSD, rgbALPINE, rgbJET, rgbSLOPS As String
For Each shp In Sheets("Calendar").Shapes
shp.Delete
Next shp
For i = 4 To 21
t1 = Sheets("AdminSheet").Cells(i, 30).Value 'Cell location on Calendar
s = Sheets("AdminSheet").Cells(i, 29).Value 'Naming the shapebox
w = Sheets("AdminSheet").Cells(i, 28).Value 'Supplier
p = Sheets("AdminSheet").Cells(i, 27).Value 'Product
t2 = Sheets("AdminSheet").Cells(i - 1, 30).Value 'Next Cell location on Calendar
v = Application.WorksheetFunction.Text(Sheets("AdminSheet").Cells(i, 24).Value, "hh:mm") & " " & _
Sheets("AdminSheet").Cells(i, 25).Value & Sheets("AdminSheet").Cells(i, 26).Value & " " & Sheets("AdminSheet").Cells(i, 27).Value 'Text in shapebox
rgbULP = rgb(177, 160, 199)
rgbPULP = rgb(255, 192, 0)
rgbSPULP = rgb(0, 112, 192)
rgbXLSD = rgb(196, 189, 151)
rgbALPINE = rgb(196, 215, 155)
rgbJET = rgb(255, 255, 255)
rgbSLOPS = rgb(255, 0, 0)
If s <> "" Then
Sheets("Calendar").Select
If i > 4 And t2 = t1 Then
s2 = Sheets("AdminSheet").Cells(i - 1, 29).Value 'Name of the added shapebox
h = Sheets("Calendar").Shapes.Range(Array(s2)).Height 'Height of the added shapebox
t3 = Sheets("Calendar").Shapes.Range(Array(s2)).Top 'Top of the added shapebox
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Sheets("Calendar").Range(t1).Left + 1.5, 3 + t3 + h, 209, 36.6).Select
Else
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Sheets("Calendar").Range(t1).Left + 1.5, Sheets("Calendar").Range(t1).Top + 3, 209, 36.6).Select
End If
With Selection
.Name = s
With .ShapeRange
.IncrementLeft 0
.IncrementTop 0
With .Fill
.Visible = msoTrue
If p = "ULP" Then
.ForeColor.rgb = rgbULP
ElseIf p = "PULP" Then
.ForeColor.rgb = rgbPULP
ElseIf p = "SPULP" Then
.ForeColor.rgb = rgbSPULP
ElseIf p = "XLSD" Then
.ForeColor.rgb = rgbXLSD
ElseIf p = "ALPINE" Then
.ForeColor.rgb = rgbALPINE
ElseIf p = "JET" Then
.ForeColor.rgb = rgbJET
ElseIf p = "SLOPS" Then
.ForeColor.rgb = rgbSLOPS
End If
.Transparency = 0
.Solid
End With
With .TextFrame2
.MarginLeft = 5.7
.MarginRight = 38.6
.AutoSize = msoAutoSizeShapeToFitText
With .TextRange.Font
.NameComplexScript = "Lucida Console"
.NameFarEast = "Lucida Console"
.Name = "Lucida Console"
.Size = 14
End With
.TextRange.Characters.Text = v
End With
End With
End With
Sheets("AdminSheet").Select
ActiveSheet.Shapes.Range(Array(w)).Select
Selection.Copy
Sheets("Calendar").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = w & s
Selection.Name = w & s
Sheets("Calendar").Shapes(w & s).Top = Sheets("Calendar").Shapes(s).Top + (Sheets("Calendar").Shapes(s).Height / 2) - (Sheets("Calendar").Shapes(w & s).Height / 2)
Sheets("Calendar").Shapes(w & s).Left = Sheets("Calendar").Shapes(s).Left + Sheets("Calendar").Shapes(s).Width - Sheets("Calendar").Shapes(w & s).Width
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
As you can see I'm very new to coding... Anyway, what I'm trying to do is to copy a pic named after "w" and paste it to the right side of the added Textbox (within the box - I guess the location would be textbox.left + textbox.width - pic.width but it doesn't work). I've tried recording it but it doesn't work for me. Any ideas?
*Edit - I updated the with the code I use for that task and the error I get. The location is wrong as well - they go outside the textbox...
I also struggle to understand how to change the fillcolor.RGB of the shape dynamically. I made it work with "if" statement but looks ugly. Any ideas how to sort the code there? Why .ForeColor.RGB = "rgb" & p not working?
Thanks in advance
I found the problem.
On the initial code, the name of the picture I was copying was not changing, hence not unique on the Sheet. So, when I was tying to move the Shape("example"), I was moving all with the same name.
Anyway, code updated with name change variable!
Wrote a macro to draw line with markers plot with excel, it works well in a single macro xlsm file. But when I tried to convert it to a excel addin (xlam file) , it got a lot of bugs. All the bugs are related to the format of both X and Y coordinates, position, font type and size of chart title, and position, font type and sizeof added text. Not sure what is the reason, need to know the correct format of them. Any debug suggestions or help, really appreciated. Please see the error message and my full macro codes as the following. Thanks.
The error message is run time error '-21474627161 (800004003)': the object is no longer valid.
After you clicked the debug, the code " .left=358" was highlighted with yellow.
But you checked with excel, the plot was drawn without chart title and the add text (that I want) and the format of coordinate was not that I tried to set. Again all these errors only happen with the xlam file, the macro works well with xlms fie.
Sub strain_plot()
sh_rows = ActiveWorkbook.ActiveSheet.Range("B65535").End(xlUp).Row
For i = 1 To sh_rows
If ActiveSheet.Cells(i, 1).Value < 0.000001 Then
ActiveSheet.Cells(i, 1).Value = 1000000000# * ActiveSheet.Cells(i, 1).Value
End If
Next i
ii = sh_rows
c_name = "chart1"
On Error GoTo err:
ActiveWorkbook.ActiveSheet.ChartObjects(c_name).Delete
err:
Set ch = ActiveWorkbook.ActiveSheet.ChartObjects.Add(330, 120, 480, 270) 'set graph position and size
ch.Name = c_name
With ch.Chart
For iii = 1 To 2
.SeriesCollection.NewSeries
.SeriesCollection(iii).Values = Range(ActiveWorkbook.ActiveSheet.Cells(1, iii + 1), ActiveWorkbook.ActiveSheet.Cells(ii, iii + 1))
.SeriesCollection(iii).XValues = Range(ActiveWorkbook.ActiveSheet.Cells(1, 1), ActiveWorkbook.ActiveSheet.Cells(ii, 1))
.SeriesCollection(iii).ChartType = xlLineMarkers
Next iii
.SeriesCollection(1).Name = "[110]"
.SeriesCollection(1).MarkerStyle = 2
.SeriesCollection(1).MarkerSize = 12
.SeriesCollection(1).MarkerForegroundColor = RGB(255, 0, 0)
.SeriesCollection(1).MarkerBackgroundColor = RGB(255, 0, 0)
.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
.SeriesCollection(2).Name = "[001]"
.SeriesCollection(2).MarkerStyle = 2
.SeriesCollection(2).MarkerSize = 12
.SeriesCollection(2).MarkerForegroundColor = RGB(96, 96, 96)
.SeriesCollection(2).MarkerBackgroundColor = RGB(96, 96, 96)
.SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(96, 96, 96)
With .Legend
.IncludeInLayout = False
.Position = xlLegendPositionRight
.AutoScaleFont = False
.Font.Size = 14
.Top = 25
.Left = 392
.Width = 72
.Height = 40
End With
With .ChartArea.Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 33
.Solid
End With
With .SeriesCollection(1).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0) 'red
.Transparency = 0
End With
With .SeriesCollection(2).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(96, 96, 96) 'grey
.Transparency = 0
End With
.HasTitle = True
With .ChartTitle
.Text = ActiveWorkbook.ActiveSheet.Cells(5, 8)
.Left = 358
.Top = 236
With .Font
.Name = "Tahoma"
.Size = 10
End With
End With
With .Axes(xlCategory)
.HasTitle = True
.AxisTitle.Text = "Position(nm)" 'X-axis title
.TickLabels.Font.Size = 10 'X-axis coordinate number size
.AxisTitle.Font.Size = 14 'X-axis title word font size
.TickMarkSpacing = 3
.TickLabelSpacing = 5
.TickLabels.NumberFormatLocal = "#,##0._);[red](#,##0.)"
.TickLabels.NumberFormatLocal = "#,##0_);[red](#,##0)"
.TickLabels.NumberFormatLocal = "0_);[red](0.)"
End With
With .Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "Strain" 'Y-aixs title
.AxisTitle.Font.Size = 14 'y-axis title word font size
'Minimum value of Y axis
.Axes(xlValue).MinimumScale = -0.005
.Axes(xlValue).TickLabels.NumberFormatLocal = "0.0%"
End With
End With
Dim thechartobj As ChartObject
Set thechartobj = ActiveWorkbook.ActiveSheet.ChartObjects(ch.Name)
Dim thechart As Chart
Set thechart = thechartobj.Chart
Dim thetextbox As Shape
Set thetextbox = thechart.Shapes.AddTextbox(msoTextOrientationHorizontal, 688, 372, 122, 20)
With thetextbox.TextFrame.Characters
.Text = ActiveSheet.Cells(6, 8)
With .Font
.Name = "tahoma"
.Size = 10
.Bold = msoTrue
End With
End With
End Sub
I have a macro which adds and removes (filterseries) set data series of a chart (in its own sheet) by looping through checkboxes in a separate sheet. When I add and remove them, I want to cycle the legend off then back on so that it resizes itself automatically.
I think this is just a syntax error of how I'm using the with statement.
I have a separate macro which does this for a different purpose, but it loops through chart-sheets and treats them as variables and, for some reason, it works there.
Sub ISurfSeries1Checklist()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim i As Integer
Dim c As Integer
For i = 1 To 56
If ActiveWorkbook.Sheets("Range").Cells(3 + i, 12).Value = True Then
ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection(i).IsFiltered = False
Else 'ActiveWorkbook.Sheets("Range").Cells(3 + i, 12) = False Then
ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection(i).IsFiltered = True
End If
Next i
For c = 51 To 56 'ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection.Count
ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection(c).Format.Line.Visible = msoTrue
ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection(c).Format.Line.ForeColor.RGB = RGB(255, 0, 0)
ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection(c).Format.Line.Transparency = 0
Next c
ActiveWorkbook.Charts("I. Surf (1)").HasLegend = False
ActiveWorkbook.Charts("I. Surf (1)").HasLegend = True
'***Below is where it stops working.***
With ActiveWorkbook.Charts("I.Surf (1)").Legend
.Font.Size = 8
.Border.Weight = xlHairline
.Border.Color = RGB(89, 89, 89)
.Interior.Color = RGB(255, 255, 255)
.Left = Cht_Sht.PlotArea.InsideLeft - Cht_Sht.Axes(xlValue).Format.Line.Weight
.Top = Cht_Sht.PlotArea.InsideTop
End With
Runtime Error '9'. Subscript out of range
on the With statement: With ActiveWorkbook.Charts("I.Surf (1)").Legend
That means a chart named "I.Surf (1)" does not exist you are probably missing the space between the dot and Surf. It should be "I. Surf (1)".
I recommend to reference the chart by a variable so you only have to use its name once. Coding rule number 1: Don't repeat yourself.
Dim ActChart As Chart
Set ActChart = ActiveWorkbook.Charts("I. Surf (1)")
This prevents typos and if you have to change it you only need to change it in one position:
Sub ISurfSeries1Checklist()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ActChart As Chart
Set ActChart = ActiveWorkbook.Charts("I. Surf (1)")
Dim i As Long
For i = 1 To 56
'Note that you can shorten this to:
ActChart.FullSeriesCollection(i).IsFiltered = Not (ActiveWorkbook.Sheets("Range").Cells(3 + i, 12).Value = True)
Next i
Dim c As Long
For c = 51 To 56 'ActiveWorkbook.Charts("I. Surf (1)").FullSeriesCollection.Count
With ActChart.FullSeriesCollection(c).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Next c
ActChart.HasLegend = False
ActChart.HasLegend = True
With ActChart.Legend
.Font.Size = 8
.Border.Weight = xlHairline
.Border.Color = RGB(89, 89, 89)
.Interior.Color = RGB(255, 255, 255)
.Left = Cht_Sht.PlotArea.InsideLeft - Cht_Sht.Axes(xlValue).Format.Line.Weight
.Top = Cht_Sht.PlotArea.InsideTop
End With
End Sub
I need to change the background image of a chart I created using vba. I tried using the .Fill command but I can't make it work. How do I do it?
This is the code I used to create the chart and it is working fine:
With myChart
.ChartStyle = 245
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = ""
.HasLegend = False
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Punteggio Tecnico"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = "Punteggio Economico"
.Axes(xlCategory).MinimumScale = 0
.Axes(xlCategory).MaximumScale = 1
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 1
.SeriesCollection(1).XValues = "=Dati2!B3:B270"
.SeriesCollection(1).Values = "=Dati2!C3:C270"
End With
If myChart is Chart variable then you want the myChart.PlotArea.Format.Fill for the area of the chart that contains the actual chart, or myChart.ChartArea.Format.Fill for the whole chart area.
The code below shows how to use it. I've commented out the colouring code that a macro recorder would supply and replaced with a basic RGB value.
Sub Test()
Dim myChart As Chart
Set myChart = Sheet1.ChartObjects("Chart 2").Chart
With myChart
With .PlotArea.Format.Fill
.ForeColor.RGB = RGB(255, 0, 0)
' .Visible = msoTrue
' .ForeColor.ObjectThemeColor = msoThemeColorAccent6
' .ForeColor.TintAndShade = 0
' .ForeColor.Brightness = 0.400000006
' .Solid
End With
With .ChartArea.Format.Fill
.ForeColor.RGB = RGB(0, 255, 0)
' .Visible = msoTrue
' .ForeColor.ObjectThemeColor = msoThemeColorAccent6
' .ForeColor.TintAndShade = 0
' .ForeColor.Brightness = 0.400000006
' .Transparency = 0
' .Solid
End With
End With
End Sub
I am fairly new to vba programming so bear with me.
I am trying to make the line and markers red for these two plots in my graph but my script only colors the first one. How do I use with selection (or something different) in a loop?
With ActiveChart
l = 1
Do Until l = 3
.SeriesCollection.NewSeries
.SeriesCollection(l).Name = Sheets("Data").Range("A" & 8 + l)
.SeriesCollection(l).XValues = Sheets("Data").Range("B7:F7")
.SeriesCollection(l).Values = Sheets("Data").Range("B" & 19 + l + LotAmount & ":F" & 19 + l + LotAmount)
With Selection
.Border.LineStyle = xlContinuous
.Border.Color = RGB(255, 0, 0)
.MarkerBackgroundColor = RGB(255, 0, 0)
.MarkerForegroundColor = RGB(255, 0, 0)
End With
l = l + 1
Loop
End With
This is probably piece of cake, so I am hoping it's an easy solve for you Guys :)
Best Regards
Lonnie
Your code is ambiguous. You want to loop through several charts but start with
with activechart
So your series name, values and color are only applied to the ActiveChart. By the way, you use With selection but you didn't really .Select anything before. Here is some code you could change a bit:
Option Explicit
Dim sht as worksheet
Dim cht as ChartObject
Set sht = Thisworkbook.Sheets("Your sheet name") ' Sheet "Data"?
For Each cht in sht.chartObjects
If cht.name = "Chart4" or cht.name = "Chart5" or cht.name = "Chart6" Then
With cht.chart.SeriesCollection[(l)]
.NewSeries
.Name = sht.range("A" & 8 [+ l])
.XValues = sht.Range("B7:F7")
.Values = Sheets("Data").Range("B" & 19 [+ l + LotAmount] & ":F" & 19 [+ l + LotAmount])
End With
With cht.chart.ChartArea
.Border.LineStyle = xlContinuous
.Border.Color = RGB(255, 0, 0)
.MarkerBackgroundColor = RGB(255, 0, 0)
.MarkerForegroundColor = RGB(255, 0, 0)
End With
End If
Next
Didn't try it but you can use this as a start. Don't hesitate for any queries. Hope this helps!
PS: Always use Option Explicit (makes variable declarations mandatory)
Edit: Only last three charts