agarwaldvk
02-22-2009, 04:16 PM
Hi Everybody
I have now, with the help of you all, been able to add a textbox on a chart in a worksheet. All the other relevant parameters of the textbox have also been specified and seem to work.
But I am still not able to add the borders to this text box. I have tried all I know.
Can someone please help!
I wonder if this is that compicated but who knows!
Sub CopyChartsAsPictures()
Dim thisObjectTop As Long, thisObjectLeft As Long
Dim myDocument As Worksheet
Dim thisSheetChartCount As Integer, start1 As Integer, wrkg1 As Integer
Dim plotAreaLeft As Double, plotAreaWidth As Double, plotAreaTop As Double, plotAreaHeight As Double
Dim chartArealeft As Double, chartAreaWidth As Double, chartAreaHeight As Double, chartAreaTop As Double
Dim chartTitleHeight As Double, chartTitleWidth As Double
Dim valueAxisLeft As Double, valueAxisTop As Double
Dim test1 As Double, test2 As Double, test3 As Double, test4 As Double
Dim chartRowConstant As Integer
Dim graphSheetName As String
graphSheetName = "Comparative Graphs"
Worksheets(graphSheetName).Activate
ActiveSheet.Cells(1, 1).Select
Set myDocument = ActiveSheet
thisSheetChartCount = myDocument.ChartObjects.Count
start1 = 4: wrkg1 = start1
Dim shapesCount As Long, i As Long
Dim thisShapeName As String
Do While wrkg1 <= thisSheetChartCount
myDocument.ChartObjects(wrkg1).Select
thisObjectTop = Selection.Top
thisObjectLeft = Selection.Left
With ActiveChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 20).TextFrame
.Characters.Text = "Data Valid to FY 2"
.AutoSize = True: .AutoMargins = False
.MarginBottom = 0: .MarginLeft = 0
.MarginRight = 0: .MarginTop = 0
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
With .Characters.Font
.Name = "Times New Roman": .Size = 10
.FontStyle = "Bold": .ColorIndex = 3
End With
End With
shapesCount = ActiveChart.Shapes.Count
For i = 1 To shapesCount
If ActiveChart.Shapes(i).Type = msoTextBox Then
ActiveChart.Shapes(i).Line.ForeColor.RGB = RGB(255, 0, 0)
' ActiveChart.Shapes(i).Top = -4 'thisObjectTop
' ActiveChart.Shapes(i).Left = -4 'thisObjectLeft
End If
End
thisShapeName = ActiveChart.Shapes(i).Name
ActiveChart.Shapes(thisShapeName).Select
Next i
End
'THIS IS WHERE THE PROBLEM IS, I THINK!
'WHERE AM I GOING WRONG?
'ActiveChart.Shapes(1).Select
With Selection
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSolid
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 64
.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End With
'YOU MAY IGNORE THIS BIT - 23/02/09!
With myDocument.ChartObjects(wrkg1).Chart
.HasTitle = True
plotAreaLeft = .PlotArea.Left: chartArealeft = .ChartArea.Left
plotAreaTop = .PlotArea.Top: chartAreaTop = .ChartArea.Top
plotAreaWidth = .PlotArea.Width: chartAreaWidth = .ChartArea.Width
plotAreaHeight = .PlotArea.Height: chartAreaHeight = .ChartArea.Height
valueAxisLeft = .Axes(xlValue).Left: valueAxisTop = .Axes(xlValue).Top
End
.ChartTitle.Top = chartAreaHeight
chartTitleHeight = (.ChartArea.Height - .ChartTitle.Top)
'.ChartTitle.Top = (chartAreaTop + Round(((plotAreaTop - chartAreaTop - chartTitleHeight) / 2), 0)) - Orig
.ChartTitle.Top = (Round(((valueAxisTop - chartAreaTop - chartTitleHeight) / 2), 0)) 'This centres better between top of plot area and top of Chart Borders
.ChartTitle.Left = chartAreaWidth
chartTitleWidth = (.ChartArea.Width - .ChartTitle.Left)
'.ChartTitle.Left = .Axes(xlValue).Left + Round(((plotAreaWidth - .Axes(xlValue).Left - chartTitleWidth) / 2), 0) - Orig
.ChartTitle.Left = .Axes(xlValue).Left + Round(((plotAreaWidth + plotAreaLeft - .Axes(xlValue).Left - chartTitleWidth) / 2), 0) 'This centres better between value axis and plot area width
test1 = .ChartTitle.Top
test2 = .ChartTitle.Left
test3 = .Axes(xlValue).Top
test4 = .Axes(xlValue).Left
End With
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlBitmap 'Picture
ActiveSheet.Paste
Selection.ShapeRange.Top = thisObjectTop
Selection.ShapeRange.Left = thisObjectLeft
myDocument.ChartObjects(wrkg1).Select
Selection.Delete
thisSheetChartCount = thisSheetChartCount - 1
Loop
End Sub
Best regards
Deepak Agarwal
I have now, with the help of you all, been able to add a textbox on a chart in a worksheet. All the other relevant parameters of the textbox have also been specified and seem to work.
But I am still not able to add the borders to this text box. I have tried all I know.
Can someone please help!
I wonder if this is that compicated but who knows!
Sub CopyChartsAsPictures()
Dim thisObjectTop As Long, thisObjectLeft As Long
Dim myDocument As Worksheet
Dim thisSheetChartCount As Integer, start1 As Integer, wrkg1 As Integer
Dim plotAreaLeft As Double, plotAreaWidth As Double, plotAreaTop As Double, plotAreaHeight As Double
Dim chartArealeft As Double, chartAreaWidth As Double, chartAreaHeight As Double, chartAreaTop As Double
Dim chartTitleHeight As Double, chartTitleWidth As Double
Dim valueAxisLeft As Double, valueAxisTop As Double
Dim test1 As Double, test2 As Double, test3 As Double, test4 As Double
Dim chartRowConstant As Integer
Dim graphSheetName As String
graphSheetName = "Comparative Graphs"
Worksheets(graphSheetName).Activate
ActiveSheet.Cells(1, 1).Select
Set myDocument = ActiveSheet
thisSheetChartCount = myDocument.ChartObjects.Count
start1 = 4: wrkg1 = start1
Dim shapesCount As Long, i As Long
Dim thisShapeName As String
Do While wrkg1 <= thisSheetChartCount
myDocument.ChartObjects(wrkg1).Select
thisObjectTop = Selection.Top
thisObjectLeft = Selection.Left
With ActiveChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 100, 20).TextFrame
.Characters.Text = "Data Valid to FY 2"
.AutoSize = True: .AutoMargins = False
.MarginBottom = 0: .MarginLeft = 0
.MarginRight = 0: .MarginTop = 0
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
With .Characters.Font
.Name = "Times New Roman": .Size = 10
.FontStyle = "Bold": .ColorIndex = 3
End With
End With
shapesCount = ActiveChart.Shapes.Count
For i = 1 To shapesCount
If ActiveChart.Shapes(i).Type = msoTextBox Then
ActiveChart.Shapes(i).Line.ForeColor.RGB = RGB(255, 0, 0)
' ActiveChart.Shapes(i).Top = -4 'thisObjectTop
' ActiveChart.Shapes(i).Left = -4 'thisObjectLeft
End If
End
thisShapeName = ActiveChart.Shapes(i).Name
ActiveChart.Shapes(thisShapeName).Select
Next i
End
'THIS IS WHERE THE PROBLEM IS, I THINK!
'WHERE AM I GOING WRONG?
'ActiveChart.Shapes(1).Select
With Selection
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSolid
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 64
.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End With
'YOU MAY IGNORE THIS BIT - 23/02/09!
With myDocument.ChartObjects(wrkg1).Chart
.HasTitle = True
plotAreaLeft = .PlotArea.Left: chartArealeft = .ChartArea.Left
plotAreaTop = .PlotArea.Top: chartAreaTop = .ChartArea.Top
plotAreaWidth = .PlotArea.Width: chartAreaWidth = .ChartArea.Width
plotAreaHeight = .PlotArea.Height: chartAreaHeight = .ChartArea.Height
valueAxisLeft = .Axes(xlValue).Left: valueAxisTop = .Axes(xlValue).Top
End
.ChartTitle.Top = chartAreaHeight
chartTitleHeight = (.ChartArea.Height - .ChartTitle.Top)
'.ChartTitle.Top = (chartAreaTop + Round(((plotAreaTop - chartAreaTop - chartTitleHeight) / 2), 0)) - Orig
.ChartTitle.Top = (Round(((valueAxisTop - chartAreaTop - chartTitleHeight) / 2), 0)) 'This centres better between top of plot area and top of Chart Borders
.ChartTitle.Left = chartAreaWidth
chartTitleWidth = (.ChartArea.Width - .ChartTitle.Left)
'.ChartTitle.Left = .Axes(xlValue).Left + Round(((plotAreaWidth - .Axes(xlValue).Left - chartTitleWidth) / 2), 0) - Orig
.ChartTitle.Left = .Axes(xlValue).Left + Round(((plotAreaWidth + plotAreaLeft - .Axes(xlValue).Left - chartTitleWidth) / 2), 0) 'This centres better between value axis and plot area width
test1 = .ChartTitle.Top
test2 = .ChartTitle.Left
test3 = .Axes(xlValue).Top
test4 = .Axes(xlValue).Left
End With
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlBitmap 'Picture
ActiveSheet.Paste
Selection.ShapeRange.Top = thisObjectTop
Selection.ShapeRange.Left = thisObjectLeft
myDocument.ChartObjects(wrkg1).Select
Selection.Delete
thisSheetChartCount = thisSheetChartCount - 1
Loop
End Sub
Best regards
Deepak Agarwal