Related
Good day! So its quiet a simple logic i want to add a picture as a default background for different sections. Like A3 portrait format has one, Landscape another, and so on. I keep on getting the 5941 Error in the code section below. Apologies for the code arrangement as it keeps on formatting it.
Application.Templates.LoadBuildingBlocks
Dim objDocument As Document
Dim objSection As Section
For i = 1 To Selection.Information(wdActiveEndPageNumber) Step 1
Set objDocument = ActiveDocument
For Each objSection In objDocument.Sections
With objSection.PageSetup
If .Orientation = wdOrientPortrait Then
'A4 portrait
If .PageHeight > CentimetersToPoints(22) And .PageHeight < CentimetersToPoints(30) And .PageWidth < CentimetersToPoints(30) Then
'In this portion, below, my code is highlighted. however if I change i to any digit, it seems working just fine. I want it to an iteration but FOR loop does not work, where did i go wrong?
Set MyImage1 = **ThisDocument.Sections(i)**.Headers(wdHeaderFooterPrimary) _
.Range.InlineShapes.AddPicture(ImagePath1).ConvertToShape
MyImage1.WrapFormat.Type = wdWrapBehind
With MyImage1
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop
.Left = wdShapeLeft
.Height = CentimetersToPoints(29.7)
.Width = CentimetersToPoints(21)
End With
'A3 portret
ElseIf .PageHeight > CentimetersToPoints(30) And .PageWidth < CentimetersToPoints(30) Then
Set MyImage7 = ThisDocument.Sections(i).Headers(wdHeaderFooterPrimary) _
.Range.InlineShapes.AddPicture(ImagePath7).ConvertToShape
MyImage7.WrapFormat.Type = wdWrapBehind
With MyImage7
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop
.Left = wdShapeLeft
.Height = CentimetersToPoints(42)
.Width = CentimetersToPoints(29.7)
End With
ElseIf .Orientation = wdOrientLandscape Then
' A4 landscape
ElseIf .PageHeight < CentimetersToPoints(22) And .PageWidth < CentimetersToPoints(30) Then
Set MyImage3 = ThisDocument.Sections(i).Headers(wdHeaderFooterPrimary) _
.Range.InlineShapes.AddPicture(ImagePath3).ConvertToShape
MyImage3.WrapFormat.Type = wdWrapBehind
With MyImage3
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop
.Left = wdShapeLeft
.Height = CentimetersToPoints(21)
.Width = CentimetersToPoints(29.7)
End With
'A3 landscape
ElseIf .PageHeight > CentimetersToPoints(30) And .PageWidth > CentimetersToPoints(30) Then
Set MyImage6 = ThisDocument.Sections(i).Headers(wdHeaderFooterPrimary) _
.Range.InlineShapes.AddPicture(ImagePath6).ConvertToShape
MyImage6.WrapFormat.Type = wdWrapBehind
With MyImage6
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = wdShapeTop
.Left = wdShapeLeft
.Height = CentimetersToPoints(29.7)
.Width = CentimetersToPoints(42)
End With
End If
End If
End With
Next
Next
Your code seems rather confused and contains several undeclared variables.
You start off with a loop stepping though a counter of the pages in
the selection. This is unnecessary and should be removed because
there is no connection between the number of pages and the number of
sections in a document.
You are setting objDocument within the initial loop. This means
that objDocument is reset at each pass through the loop. Set
objDocument = ActiveDocument should be moved to the beginning of
your code before the loop begins.
You then loop through the sections in objDocument. This is the only
loop you need in your code.
When you come to adding the image you suddenly switch from
objDocument to ThisDocument. Depending on where the code modules
are located ThisDocument may not be the same document as
objDocument.
You then introduce a further potential source of error with
ThisDocument.Sections(i). As the counter you are using is not
related to the number of sections it is highly likely that
ThisDocument.Sections(i) doesn't exist. You should replace this
with objSection.
I am experiencing an error in a subroutine attempting to set the plotarea.width property of a chart.
The other dimensions also cause this error if I comment out the preceding line(s).
There is no ActiveChart, no selection, etc. The specific error message is this: "-2147467259 (80004005) Method 'Width' of object 'PlotArea' failed"
This is stumping me for several reasons:
In debug mode, F8 to step through the code the error does NOT occur.
AFAIK "width" is not a "method" but a "property" of the chart's plotarea, so even the error message is rather ambiguous.
Any thoughts? Here's as much code as I can share, the ChartSizeMedium subroutine in its entirety, and a dummy snippet to show you how I am establishing the chart and passing it to that sub which sets the size & some other properties prior to passing to another function which adds the series data to the chart.
Option Explicit
Private Sub EstablishChartObject()
Dim cObj as ChartObject
Set cObj = ActiveSheet.ChartObjects.Add(Left:=30, Top:30, Width:=740, Height:=300)
ChartSizeMedium cObj.Chart, "Integer", "Example Chart Title"
End Sub
Private Sub ChartSizeMedium(cht As Chart, NumType As String, Optional chtTitle As String)
'Subroutine to make a consistent size chart
Dim s As Long
With cht
'Add a chart title if one exists.
If Len(chtTitle) > 0 Then
.HasTitle = True
.chartTitle.Characters.Text = chtTitle
End If
'Create the default chart Legend
.HasLegend = True
With .Legend
.Position = xlTop
.Font.Size = 11
.Font.Bold = True
End With
'Format the axes
.Axes(xlValue).MajorGridlines.Format.Line.Visible = msoFalse
.Axes(xlValue).MinorGridlines.Format.Line.Visible = msoFalse
'Format the size of the chart
With .Parent
.Width = 740
.Height = 396
End With
With .PlotArea
.Width = 640 '<---- THIS LINE TRIGGERS THE ERROR
.Height = 280
.Left = 30
.Top = 30
End With
End With
'Some charts start with more than one series container, so make sure they're gone:
With cht
Do Until .SeriesCollection.Count = 0
s = .SeriesCollection.Count
.SeriesCollection(s).Delete
Loop
End With
End Sub
UPDATE Dec 12, 2012
I remove all non-problematic code and use only the PlotArea with block, in the same routine, I have also tried setting the chart type (several values) and as shown in this example, manually adding one series of data prior to attempting to set the PlotArea dimensions, but the error persists:
Option Explicit
Private Sub EstablishChartObject2()
Dim cObj As ChartObject
Dim sh As Worksheet
Set sh = ActiveSheet
Dim srs As Series
Set cObj = sh.ChartObjects.Add(Left:=30, Top:=30, Width:=740, Height:=300)
Set srs = cObj.Chart.SeriesCollection.NewSeries
srs.Values = "={1,3,5,7,4}"
cObj.Chart.ChartType = 57
With cObj.Chart.PlotArea
.Width = 100 '<---- THIS LINE TRIGGERS THE ERROR
.Height = 280
.Left = 30
.Top = 30
End With
End Sub
i had a similar problem . And its definitely an excel issue (having 2013).
With .PlotArea
.Select 'err if delete this line of code
.Top = 0
.Left = 0
.width = 40
.Height = 40
End With
if you remove the .selectline, it will result in error on the next line.
note that i am not working with a <with selectiondo stuff>.
the .selectmakes it work, without using the selection, wich is obviously an excel bug (from previous versions?)
Two solutions that seem to be working, neither is really as "elegant" as I'd prefer (I was hoping there would be a way to do this with selecting the chart or any part of it).
Option 1 - Select the plot area and then deselect it. This seems to be the most reliable/efficient solution.
With .PlotArea
Application.ScreenUpdating = False
.Select
With Selection
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
ActiveSheet.Range("A1").Activate
End With
Application.ScreenUpdating = True
End With
Option 2 - disable error-handling in loop (this followed from Doug's link). This doesn't seem to be a very reliable or efficient method, and although it seems to work, I know that within that loop it is failing once on each of the properties before it successfully sets them on a subsequent pass.
With .PlotArea
For pLoop = 1 To 5
On Error Resume Next
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
On Error GoTo 0
Next
End With
Hope your sheet and chart has the ability to get a width up to 640. If so try the explicit reference. Also suggest you to change width, height values to lower values and see how programme responds. Since you said, when you select it works,
that also means, your cht is wrapping the correct chart object - unless otherwise you selected the chart using ActiveChart.PlotArea.Width . Hence I guess explicit reference could do be a potential try out.
,
cht.PlotArea.Width = 640
cht.PlotArea.Height = 280
cht.PlotArea.Left = 30
cht.PlotArea.Top = 30
Further, check on Aspect Ratio lock or unlock. If none of these works, then add a chart into your sheet and use most simple chart formatting code to check on widht, height, left, top changes.
Update two
Let's try specifing chart type and setting up chart object in the second sub as well. I tried out in my end and it's working. Try the code with following changes.
Code:
Calling this sub from the button showed in the sheet.
Option Explicit
Public Sub EstablishChartObject()
Dim mySheet As Worksheet
Dim cObj As ChartObject
Application.ScreenUpdating = False
Application.StatusBar = "Chart is coming soon..."
Set mySheet = Sheets(2) '-- set according to yours
'-- create chart with some source data first, which you can change later
Set cObj = mySheet.ChartObjects.Add(Left:=30, Top:=30, Width:=400, Height:=200)
ChartSizeMedium cObj, "Integer", "Example Chart Title"
End Sub
'Subroutine to make a consistent size chart
Private Sub ChartSizeMedium(chtObj As ChartObject, NumType As String, _
Optional chtTitle As String)
Dim myChart As Chart
Dim s As Long
Set myChart = chtObj.Chart '-- specify chart type
myChart.SetSourceData Source:=Sheets(2).Range("B3:C12") '-- set to what you have
myChart.ChartType = xlXYScatterLines '-- set to the type you want
'and make sure to **use correct properties**
With myChart
If .HasTitle Then
.ChartTitle.Characters.Text = chtTitle
End If
'Create the default chart Legend
If .HasLegend Then
With .Legend
.Position = xlTop
.Font.Size = 11
.Font.Bold = True
End With
End If
'Format the axes
With .Axes(xlValue)
.HasMajorGridlines = False
End With
'Format the size of the chart
With .Parent
.Width = 400 '-- change to yours
.Height = 250 '-- change to yours
End With
With .PlotArea
.Width = 300 '-- change to yours
.Height = 180 '-- change to yours
.Left = 30
.Top = 30
End With
End With
Application.ScreenUpdating = True
Application.StatusBar = "Chart is Here!"
End Sub
Otput:
Make sure to use correct properties for each chart type. Note that above code doesn't delete any left over, old charts from your sheet.
.MajoreGridlines.Format.Lines.Visible fails. So set the .MajorGridlines = False to make sure you do not want to show the gridlines.
Anything else you want to do can be done later. Just try with the changes to dimension initially.
Reference from : MSDN Gridlines property
I know this is old, and this solution seems bad, but it works. I only thought to do it as you mention that stepping through works.
Option Explicit
Sub chart()
Dim cObj As ChartObject
Dim sh As Worksheet
Set sh = ActiveSheet
Dim srs As Series
Set cObj = sh.ChartObjects.Add(Left:=30, Top:=30, Width:=740, Height:=300)
cObj.chart.ChartType = 57
Set srs = cObj.chart.SeriesCollection.NewSeries
srs.Values = "={1,3,5,7,4}"
Application.Wait Now + TimeValue("00:00:01") '<~~ Added This line
With cObj.chart.PlotArea
.Width = 100
.Height = 280
.Left = 30
.Top = 30
End With
End Sub
EDIT: This seems to work for some chart types, but it was still failing for other chart types. I have continued to use the 5x loop with On Error Resume Next and that seems to be -- unfortunately -- the most "reliable" solution to-date.
Original: This is based on User2140261's suggested answer, above:
https://stackoverflow.com/a/16041640/1467082
Since the question was initially posted, the application now resides in PowerPoint, so I cannot use the Applicaiton.Wait. I had some intermittent errors with a 1-second pause, and 3-seconds was too much of a pause, so I built the following error trap. The same idea could be used in Excel in conjunction with Application.Wait.
It was this block of code that was giving me fits, so I added this error handling in Powerpoint to mimic the Application.Wait.
RetryChartDimensions:
On Error GoTo ErrChartDimensions
With .PlotArea
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
End With
On Error GoTo 0
' More code
' more code
Exit Sub 'gracefully exit this subroutine before the error-handling.'
ErrChartDimensions:
Err.Clear
'Pause before setting the PlotArea dimensions:'
Dim wtTime As Double
Dim startTime As Long
'A maximum 3 second delay should be more than enough time.
If wtTime < 3 Then
wtTime = wtTime + 0.5
startTime = Timer
While Timer < startTime + wtTime
DoEvents
Wend
End If
Resume RetryChartDimensions
End Sub
I don't have enough reputation to add a comment, so using the above solutions I have fixed my problem with Pie Charts in VB.Net 2010 and Excel 2013. xlLine charts never caused a problem, but my code would crash when the same code was ran against an xlPie chart on Excel 2013 (All was fine on Excel 2007).
My now working code:
appExcel.Visible = False
xlchart_for_96_Well_Plate_Source = appExcel.Charts.Add(After:=wkbExperiment_Details.Sheets(wkbExperiment_Details.Sheets.Count))
appExcel.ScreenUpdating = False
With xlchart_for_96_Well_Plate_Source
.SetSourceData(Source:=wksData.Range(wksData.Cells(2, byteCharts_added), wksData.Cells(intUsed_Rows, byteCharts_added)), PlotBy:=Microsoft.Office.Interop.Excel.XlRowCol.xlColumns)
.ChartType = objChart_Type
.PlotArea.Select()
.PlotArea.Top = 2
.PlotArea.Select()
.PlotArea.Left = 2
.SeriesCollection(.SeriesCollection.count).xvalues = wksData.Range(wksData.Cells(2, 1), wksData.Cells(intUsed_Rows, 1)).Value ' Scale - wavelength for line chart
.SeriesCollection(.SeriesCollection.count).Values = wksData.Range(wksData.Cells(2, byteCharts_added + 1), wksData.Cells(intUsed_Rows, byteCharts_added + 1)).Value
.SeriesCollection(.SeriesCollection.count).Name = wksData.Cells(1, .SeriesCollection.count + 1).value
End With
appExcel.ScreenUpdating = True
I'm a beginner with VBA, I'm developing a macro on excel 2007 and I'm having some problems with the ComboBox. Anywhere I try to add items i always get the error 70 "Permission Denied". What is my mistake?
Below you can find my simple code
Private Sub CommandButton2_Click()
Dim pic As IPictureDisp
Set pic = UserForm1.Image1.Picture
'stdole.SavePicture pic, "ciao"
Call SavePicture(pic, "ciao.jpg")
End Sub
Private Sub CommandButton3_Click()
Dim MyChart As Chart
Dim ChartData As Range
Dim ChartName As String
ChartName = "ANCONA"
Set ChartData = ActiveSheet.Range("A1:A9")
Application.ScreenUpdating = True
'UserForm1.Image4.Picture = LoadPicture("C:\Users\rfori\Desktop\PROGETTO
MARTINA\parto_trig.jpg")
'
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
With MyChart.SeriesCollection.NewSeries
.Name = ChartName
.Values = ChartData
.XValues = ActiveSheet.Range("B1:B9")
End With
Dim imageName As String
imageName = "prova.jpg"
MyChart.Export Filename:=imageName, FilterName:="jpg"
Application.ScreenUpdating = True
UserForm1.Image1.Picture = LoadPicture("prova.jpg")
'MyChart.SeriesCollection(1).Name = ChartName
'MyChart.SetSourceData Source:=ChartData
End Sub
Private Sub UserForm_Activate()
ComboBox1.AddItem "ciao"
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "ciao"
With Me
.StartUpPosition = 1
.Width = MultiPage1.Width
.Height = MultiPage1.Height
.Left = Application.Left - (Application.Width * 0.85) \ 2
.Top = Application.Top - (Application.Height * 0.85) \ 2
End With
myarray1 = Array("Ancona", "Milano", "Palermo")
For x = 0 To 2
'ComboBox1.AddItem myarray1(x)
Next x
End Sub
Sub window_sizer()
With ActiveWindow
.WindowState = xlNormal`enter code here`
.Height = 75
.Width = 125
.ScrollColumn = 1
.ScrollRow = 1
End Sub
Thank you in advance
had the same problem before as described in Combobox additem permission denied error no.70
.
Make sure that the property ListFillRange is empty.
I'm adding ".jpg" files to my Excel sheet with the code below :
'Add picture to excel
xlApp.Cells(i, 20).Select
xlApp.ActiveSheet.Pictures.Insert(picPath).Select
'Calgulate new picture size
With xlApp.Selection.ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
'Resize and make printable
With xlApp.Selection
.Placement = 1 'xlMoveAndSize
'.Placement = 2 'xlMove
'.Placement = 3 'xlFreeFloating
.PrintObject = True
End With
I don't know what I am doing wrong but it doesn't get inserted into the right cell, so what should I do to put this picture into a specified cell in Excel?
Try this:
With xlApp.ActiveSheet.Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 75
.Height = 100
End With
.Left = xlApp.ActiveSheet.Cells(i, 20).Left
.Top = xlApp.ActiveSheet.Cells(i, 20).Top
.Placement = 1
.PrintObject = True
End With
It's better not to .select anything in Excel, it is usually never necessary and slows down your code.
Looking at posted answers I think this code would be also an alternative for someone. Nobody above used .Shapes.AddPicture in their code, only .Pictures.Insert()
Dim myPic As Object
Dim picpath As String
picpath = "C:\Users\photo.jpg" 'example photo path
Set myPic = ws.Shapes.AddPicture(picpath, False, True, 20, 20, -1, -1)
With myPic
.Width = 25
.Height = 25
.Top = xlApp.Cells(i, 20).Top 'according to variables from correct answer
.Left = xlApp.Cells(i, 20).Left
.LockAspectRatio = msoFalse
End With
I'm working in Excel 2013. Also realized that You need to fill all the parameters in .AddPicture, because of error "Argument not optional". Looking at this You may ask why I set Height and Width as -1, but that doesn't matter cause of those parameters are set underneath between With brackets.
Hope it may be also useful for someone :)
If it's simply about inserting and resizing a picture, try the code below.
For the specific question you asked, the property TopLeftCell returns the range object related to the cell where the top left corner is parked. To place a new image at a specific place, I recommend creating an image at the "right" place and registering its top and left properties values of the dummy onto double variables.
Insert your Pic assigned to a variable to easily change its name. The Shape Object will have that same name as the Picture Object.
Sub Insert_Pic_From_File(PicPath as string, wsDestination as worksheet)
Dim Pic As Picture, Shp as Shape
Set Pic = wsDestination.Pictures.Insert(FilePath)
Pic.Name = "myPicture"
'Strongly recommend using a FileSystemObject.FileExists method to check if the path is good before executing the previous command
Set Shp = wsDestination.Shapes("myPicture")
With Shp
.Height = 100
.Width = 75
.LockAspectRatio = msoTrue 'Put this later so that changing height doesn't change width and vice-versa)
.Placement = 1
.Top = 100
.Left = 100
End with
End Sub
Good luck!
I have been working on a system that ran on a PC and Mac and was battling to find code that worked for inserting pictures on both PC and Mac. This worked for me so hopefully someone else can make use of it!
Note: the strPictureFilePath and strPictureFileName variables need to be set to valid PC and Mac paths Eg
For PC: strPictureFilePath = "E:\Dropbox\" and strPictureFileName = "TestImage.jpg" and with Mac: strPictureFilePath = "Macintosh HD:Dropbox:" and strPictureFileName = "TestImage.jpg"
Code as Follows:
On Error GoTo ErrorOccured
shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Select
ActiveSheet.Pictures.Insert(Trim(strPictureFilePath & strPictureFileName)).Select
Selection.ShapeRange.Left = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Left
Selection.ShapeRange.Top = shtRecipeBrowser.Cells(intDestinationRecipeRowCount, 1).Top + 10
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 130
Firstly, of all I recommend that the pictures are in the same folder as the workbook.
You need to enter some codes in the Worksheet_Change procedure of the worksheet. For example, we can enter the following codes to add the image that with the same name as the value of cell in column A to the cell in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pic As Picture
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
On Error GoTo son
For Each pic In ActiveSheet.Pictures
If Not Application.Intersect(pic.TopLeftCell, Range(Target.Offset(0, 3).Address)) Is Nothing Then
pic.Delete
End If
Next pic
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 2).Top
Selection.Left = Target.Offset(0, 3).Left
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = Target.Offset(0, 2).Height
Selection.ShapeRange.Width = Target.Offset(0, 3).Width
son:
End Sub
With the codes above, the picture is sized according to the cell it is added to.
Details and sample file here : Vba Insert image to cell
I tested both #SWa and #Teamothy solution. I did not find the Pictures.Insert Method in the Microsoft Documentations and feared some compatibility issues. So I guess, the older Shapes.AddPicture Method should work on all versions. But it is slow!
On Error Resume Next
'
' first and faster method (in Office 2016)
'
With ws.Pictures.Insert(Filename:=imageFileName, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
.Left = destRange.Left
.Top = destRange.Top
.Placement = 1
.PrintObject = True
.Name = imageName
End With
'
' second but slower method (in Office 2016)
'
If Err.Number <> 0 Then
Err.Clear
Dim myPic As Shape
Set myPic = ws.Shapes.AddPicture(Filename:=imageFileName, _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=destRange.Left, Top:=destRange.Top, Width:=-1, height:=destRange.height)
With myPic.OLEFormat.Object.ShapeRange
.LockAspectRatio = msoTrue
.Width = destRange.Width
.height = destRange.height '222
End With
End If
I am experiencing an error in a subroutine attempting to set the plotarea.width property of a chart.
The other dimensions also cause this error if I comment out the preceding line(s).
There is no ActiveChart, no selection, etc. The specific error message is this: "-2147467259 (80004005) Method 'Width' of object 'PlotArea' failed"
This is stumping me for several reasons:
In debug mode, F8 to step through the code the error does NOT occur.
AFAIK "width" is not a "method" but a "property" of the chart's plotarea, so even the error message is rather ambiguous.
Any thoughts? Here's as much code as I can share, the ChartSizeMedium subroutine in its entirety, and a dummy snippet to show you how I am establishing the chart and passing it to that sub which sets the size & some other properties prior to passing to another function which adds the series data to the chart.
Option Explicit
Private Sub EstablishChartObject()
Dim cObj as ChartObject
Set cObj = ActiveSheet.ChartObjects.Add(Left:=30, Top:30, Width:=740, Height:=300)
ChartSizeMedium cObj.Chart, "Integer", "Example Chart Title"
End Sub
Private Sub ChartSizeMedium(cht As Chart, NumType As String, Optional chtTitle As String)
'Subroutine to make a consistent size chart
Dim s As Long
With cht
'Add a chart title if one exists.
If Len(chtTitle) > 0 Then
.HasTitle = True
.chartTitle.Characters.Text = chtTitle
End If
'Create the default chart Legend
.HasLegend = True
With .Legend
.Position = xlTop
.Font.Size = 11
.Font.Bold = True
End With
'Format the axes
.Axes(xlValue).MajorGridlines.Format.Line.Visible = msoFalse
.Axes(xlValue).MinorGridlines.Format.Line.Visible = msoFalse
'Format the size of the chart
With .Parent
.Width = 740
.Height = 396
End With
With .PlotArea
.Width = 640 '<---- THIS LINE TRIGGERS THE ERROR
.Height = 280
.Left = 30
.Top = 30
End With
End With
'Some charts start with more than one series container, so make sure they're gone:
With cht
Do Until .SeriesCollection.Count = 0
s = .SeriesCollection.Count
.SeriesCollection(s).Delete
Loop
End With
End Sub
UPDATE Dec 12, 2012
I remove all non-problematic code and use only the PlotArea with block, in the same routine, I have also tried setting the chart type (several values) and as shown in this example, manually adding one series of data prior to attempting to set the PlotArea dimensions, but the error persists:
Option Explicit
Private Sub EstablishChartObject2()
Dim cObj As ChartObject
Dim sh As Worksheet
Set sh = ActiveSheet
Dim srs As Series
Set cObj = sh.ChartObjects.Add(Left:=30, Top:=30, Width:=740, Height:=300)
Set srs = cObj.Chart.SeriesCollection.NewSeries
srs.Values = "={1,3,5,7,4}"
cObj.Chart.ChartType = 57
With cObj.Chart.PlotArea
.Width = 100 '<---- THIS LINE TRIGGERS THE ERROR
.Height = 280
.Left = 30
.Top = 30
End With
End Sub
i had a similar problem . And its definitely an excel issue (having 2013).
With .PlotArea
.Select 'err if delete this line of code
.Top = 0
.Left = 0
.width = 40
.Height = 40
End With
if you remove the .selectline, it will result in error on the next line.
note that i am not working with a <with selectiondo stuff>.
the .selectmakes it work, without using the selection, wich is obviously an excel bug (from previous versions?)
Two solutions that seem to be working, neither is really as "elegant" as I'd prefer (I was hoping there would be a way to do this with selecting the chart or any part of it).
Option 1 - Select the plot area and then deselect it. This seems to be the most reliable/efficient solution.
With .PlotArea
Application.ScreenUpdating = False
.Select
With Selection
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
ActiveSheet.Range("A1").Activate
End With
Application.ScreenUpdating = True
End With
Option 2 - disable error-handling in loop (this followed from Doug's link). This doesn't seem to be a very reliable or efficient method, and although it seems to work, I know that within that loop it is failing once on each of the properties before it successfully sets them on a subsequent pass.
With .PlotArea
For pLoop = 1 To 5
On Error Resume Next
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
On Error GoTo 0
Next
End With
Hope your sheet and chart has the ability to get a width up to 640. If so try the explicit reference. Also suggest you to change width, height values to lower values and see how programme responds. Since you said, when you select it works,
that also means, your cht is wrapping the correct chart object - unless otherwise you selected the chart using ActiveChart.PlotArea.Width . Hence I guess explicit reference could do be a potential try out.
,
cht.PlotArea.Width = 640
cht.PlotArea.Height = 280
cht.PlotArea.Left = 30
cht.PlotArea.Top = 30
Further, check on Aspect Ratio lock or unlock. If none of these works, then add a chart into your sheet and use most simple chart formatting code to check on widht, height, left, top changes.
Update two
Let's try specifing chart type and setting up chart object in the second sub as well. I tried out in my end and it's working. Try the code with following changes.
Code:
Calling this sub from the button showed in the sheet.
Option Explicit
Public Sub EstablishChartObject()
Dim mySheet As Worksheet
Dim cObj As ChartObject
Application.ScreenUpdating = False
Application.StatusBar = "Chart is coming soon..."
Set mySheet = Sheets(2) '-- set according to yours
'-- create chart with some source data first, which you can change later
Set cObj = mySheet.ChartObjects.Add(Left:=30, Top:=30, Width:=400, Height:=200)
ChartSizeMedium cObj, "Integer", "Example Chart Title"
End Sub
'Subroutine to make a consistent size chart
Private Sub ChartSizeMedium(chtObj As ChartObject, NumType As String, _
Optional chtTitle As String)
Dim myChart As Chart
Dim s As Long
Set myChart = chtObj.Chart '-- specify chart type
myChart.SetSourceData Source:=Sheets(2).Range("B3:C12") '-- set to what you have
myChart.ChartType = xlXYScatterLines '-- set to the type you want
'and make sure to **use correct properties**
With myChart
If .HasTitle Then
.ChartTitle.Characters.Text = chtTitle
End If
'Create the default chart Legend
If .HasLegend Then
With .Legend
.Position = xlTop
.Font.Size = 11
.Font.Bold = True
End With
End If
'Format the axes
With .Axes(xlValue)
.HasMajorGridlines = False
End With
'Format the size of the chart
With .Parent
.Width = 400 '-- change to yours
.Height = 250 '-- change to yours
End With
With .PlotArea
.Width = 300 '-- change to yours
.Height = 180 '-- change to yours
.Left = 30
.Top = 30
End With
End With
Application.ScreenUpdating = True
Application.StatusBar = "Chart is Here!"
End Sub
Otput:
Make sure to use correct properties for each chart type. Note that above code doesn't delete any left over, old charts from your sheet.
.MajoreGridlines.Format.Lines.Visible fails. So set the .MajorGridlines = False to make sure you do not want to show the gridlines.
Anything else you want to do can be done later. Just try with the changes to dimension initially.
Reference from : MSDN Gridlines property
I know this is old, and this solution seems bad, but it works. I only thought to do it as you mention that stepping through works.
Option Explicit
Sub chart()
Dim cObj As ChartObject
Dim sh As Worksheet
Set sh = ActiveSheet
Dim srs As Series
Set cObj = sh.ChartObjects.Add(Left:=30, Top:=30, Width:=740, Height:=300)
cObj.chart.ChartType = 57
Set srs = cObj.chart.SeriesCollection.NewSeries
srs.Values = "={1,3,5,7,4}"
Application.Wait Now + TimeValue("00:00:01") '<~~ Added This line
With cObj.chart.PlotArea
.Width = 100
.Height = 280
.Left = 30
.Top = 30
End With
End Sub
EDIT: This seems to work for some chart types, but it was still failing for other chart types. I have continued to use the 5x loop with On Error Resume Next and that seems to be -- unfortunately -- the most "reliable" solution to-date.
Original: This is based on User2140261's suggested answer, above:
https://stackoverflow.com/a/16041640/1467082
Since the question was initially posted, the application now resides in PowerPoint, so I cannot use the Applicaiton.Wait. I had some intermittent errors with a 1-second pause, and 3-seconds was too much of a pause, so I built the following error trap. The same idea could be used in Excel in conjunction with Application.Wait.
It was this block of code that was giving me fits, so I added this error handling in Powerpoint to mimic the Application.Wait.
RetryChartDimensions:
On Error GoTo ErrChartDimensions
With .PlotArea
.Width = paWidth
.Height = paHeight
.Left = paLeft
.Top = paTop
End With
On Error GoTo 0
' More code
' more code
Exit Sub 'gracefully exit this subroutine before the error-handling.'
ErrChartDimensions:
Err.Clear
'Pause before setting the PlotArea dimensions:'
Dim wtTime As Double
Dim startTime As Long
'A maximum 3 second delay should be more than enough time.
If wtTime < 3 Then
wtTime = wtTime + 0.5
startTime = Timer
While Timer < startTime + wtTime
DoEvents
Wend
End If
Resume RetryChartDimensions
End Sub
I don't have enough reputation to add a comment, so using the above solutions I have fixed my problem with Pie Charts in VB.Net 2010 and Excel 2013. xlLine charts never caused a problem, but my code would crash when the same code was ran against an xlPie chart on Excel 2013 (All was fine on Excel 2007).
My now working code:
appExcel.Visible = False
xlchart_for_96_Well_Plate_Source = appExcel.Charts.Add(After:=wkbExperiment_Details.Sheets(wkbExperiment_Details.Sheets.Count))
appExcel.ScreenUpdating = False
With xlchart_for_96_Well_Plate_Source
.SetSourceData(Source:=wksData.Range(wksData.Cells(2, byteCharts_added), wksData.Cells(intUsed_Rows, byteCharts_added)), PlotBy:=Microsoft.Office.Interop.Excel.XlRowCol.xlColumns)
.ChartType = objChart_Type
.PlotArea.Select()
.PlotArea.Top = 2
.PlotArea.Select()
.PlotArea.Left = 2
.SeriesCollection(.SeriesCollection.count).xvalues = wksData.Range(wksData.Cells(2, 1), wksData.Cells(intUsed_Rows, 1)).Value ' Scale - wavelength for line chart
.SeriesCollection(.SeriesCollection.count).Values = wksData.Range(wksData.Cells(2, byteCharts_added + 1), wksData.Cells(intUsed_Rows, byteCharts_added + 1)).Value
.SeriesCollection(.SeriesCollection.count).Name = wksData.Cells(1, .SeriesCollection.count + 1).value
End With
appExcel.ScreenUpdating = True