how can i solve error "-2147467259(80004005)???

zohre_ebrahimi

New Member
Joined
May 5, 2015
Messages
1
Hi my freinds

I am using an MSExcel template (MAKESENS 1.0, it's free and available online) to calculate the Mann-Kandall test and Sen's slope for a trend analysis of a precepitation time series. I get an error message ""-2147467259(80004005)". If I click debug, it shows that the bold line is an issue (I attached the code below, please see the bold line at the end).





aws a figure based on the table in "Figure"
' Made by Toni Amnell 5.4.2002

Dim rows As Integer
Dim value As String
Dim i As Integer
Dim drawrange As Range
Dim figureExists As Boolean
Dim apu As String
Dim conf99 As Boolean
Dim conf95 As Boolean
Dim resid As Boolean
Dim title(1 To 8) As String

'Sheets("Figure").Unprotect

' If the amount of the data is zero, exit the subroutine
If Sheets("Figure").Cells(12, 3).value = 0 Then
Sheets("Figure").Cells(1, 1).Select
Exit Sub
End If

' Disable the updating of the screen
Application.ScreenUpdating = False

' check that the old figure exists
figureExists = False
i = 0
Do While i < Sheets("Figure").ChartObjects.Count
i = i + 1
If Sheets("Figure").ChartObjects(i).Name = "figure" Then
figureExists = True
Exit Do
End If
Loop

' Number of rows in the table
value = "x"
rows = -1
Do While value <> ""
rows = rows + 1
value = Sheets("Figure").Cells(rows + 30, 6).value
Loop

'Titles of contours
For i = 1 To 8
title(i) = Sheets("Figure").Cells(29, 5 + i).value
Next i

' The wanted contours
conf99 = True
conf95 = True
resid = True
If Sheets("Figure").Cells(30, 2).value = "" Then
conf99 = False
End If
If Sheets("Figure").Cells(31, 2).value = "" Then
conf95 = False
End If
If Sheets("Figure").Cells(33, 2).value = "" Then
resid = False
End If

If Not figureExists Then
' Choose the data area and add the figure
Sheets("Figure").Select
Set drawrange = Range(Cells(29, 6), Cells(29 + rows, 13))
drawrange.Select
Charts.Add

' Charttype
ActiveChart.ChartType = xlXYScatterLines

' data source, new sheet and its name
ActiveChart.SetSourceData Source:=drawrange, PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Figure"

' Titles of the chart
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = ""
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Year"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _
Sheets("Figure").Cells(10, 3).value
End With

' Existence of axis
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With

' Type of x-axis
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic


' Gridlines
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With

' No data labels
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False

' Plotarea
ActiveChart.PlotArea.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
Selection.Interior.ColorIndex = xlNone
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Interior.ColorIndex = xlNone

' Style of contours

' Contour 1 (time serie)
ActiveChart.Legend.LegendEntries(1).LegendKey.Select
With Selection.Border
.ColorIndex = 1
.Weight = xlMedium
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlCircle
.Smooth = False
.MarkerSize = 7
.Shadow = False
End With

' Contour 2 (Q)
ActiveChart.Legend.LegendEntries(2).LegendKey.Select
With Selection.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Contour 3 (Qmin01)
ActiveChart.Legend.LegendEntries(3).LegendKey.Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlDot
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Contour 4 (Qmax01)
ActiveChart.Legend.LegendEntries(4).LegendKey.Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlDot
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Contour 5 (Qmin05)
ActiveChart.Legend.LegendEntries(5).LegendKey.Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThin
.LineStyle = xlDash
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Contour 6 (Qmax05)
ActiveChart.Legend.LegendEntries(6).LegendKey.Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThin
.LineStyle = xlDash
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Contour 7 (Residual)
ActiveChart.Legend.LegendEntries(7).LegendKey.Select
With Selection.Border
.ColorIndex = 14
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = 14
.MarkerStyle = xlX
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With

' Remove the unwanted contours
If Not conf99 Then
If exists(9, rows) Then
ActiveChart.SeriesCollection(title(4)).Delete
End If
If exists(10, rows) Then
ActiveChart.SeriesCollection(title(5)).Delete
End If
End If
If Not conf95 Then
If exists(11, rows) Then
ActiveChart.SeriesCollection(title(6)).Delete
End If
If exists(12, rows) Then
ActiveChart.SeriesCollection(title(7)).Delete
End If
End If
If Not resid And exists(13, rows) Then
ActiveChart.SeriesCollection(title(8)).Delete
End If

' Move and rezize the chart
Sheets("Figure").ChartObjects(1).Name = "figure"
ActiveSheet.ChartObjects("figure").Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("figure").IncrementLeft 35.25
ActiveSheet.Shapes("figure").IncrementTop -30
ActiveSheet.Shapes("figure").ScaleHeight 1.28, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("figure").ScaleWidth 1.3, msoFalse, msoScaleFromTopLeft
Else ' the figure exists
ActiveSheet.ChartObjects("figure").Activate
ActiveChart.ChartArea.Select

' The title of y-axis
With ActiveChart
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _
Sheets("Figure").Cells(10, 3).value
End With

' The contours
For i = 1 To 7
Sheets("Figure").Select
Sheets("Figure").Cells(1, 1).Select
Set drawrange = Range(Cells(30, 6), Cells(29 + rows, 6))
ActiveSheet.ChartObjects("figure").Activate
If (i = 1 And exists(7, rows)) Or (i = 2 And exists(8, rows)) Then
ActiveChart.SeriesCollection(i).XValues = drawrange
ElseIf i = 3 And conf99 And exists(9, rows) Then
ActiveChart.SeriesCollection(title(4)).XValues = drawrange
ElseIf i = 4 And conf99 And exists(10, rows) Then
ActiveChart.SeriesCollection(title(5)).XValues = drawrange
ElseIf i = 5 And conf95 And exists(11, rows) Then
ActiveChart.SeriesCollection(title(6)).XValues = drawrange
ElseIf i = 6 And conf95 And exists(12, rows) Then
ActiveChart.SeriesCollection(title(7)).XValues = drawrange
ElseIf i = 7 And resid And exists(13, rows) Then
ActiveChart.SeriesCollection(title(8)).XValues = drawrange
End If

Sheets("Figure").Cells(1, 1).Select
Set drawrange = Sheets("Figure").Range(Cells(30, i + 6), Cells(29 + rows, i + 6))
ActiveSheet.ChartObjects("figure").Activate
If (i = 1 And exists(7, rows)) Or (i = 2 And exists(8, rows)) Then
ActiveChart.SeriesCollection(i).values = drawrange
ActiveChart.SeriesCollection(i).Name = Sheets("Figure").Cells(29, i + 6).value
ElseIf i = 3 And conf99 And exists(9, rows) Then
ActiveChart.SeriesCollection(title(4)).values = drawrange
ActiveChart.SeriesCollection(title(4)).Name = Sheets("Figure").Cells(29, i + 6).value
ElseIf i = 4 And conf99 And exists(10, rows) Then
ActiveChart.SeriesCollection(title(5)).values = drawrange
ActiveChart.SeriesCollection(title(5)).Name = Sheets("Figure").Cells(29, i + 6).value
ElseIf i = 5 And conf95 And exists(11, rows) Then
ActiveChart.SeriesCollection(title(6)).values = drawrange
ActiveChart.SeriesCollection(title(6)).Name = Sheets("Figure").Cells(29, i + 6).value
ElseIf i = 6 And conf95 And exists(12, rows) Then
ActiveChart.SeriesCollection(title(7)).values = drawrange
ActiveChart.SeriesCollection(title(7)).Name = Sheets("Figure").Cells(29, i + 6).value
ElseIf i = 7 And resid And exists(13, rows) Then
ActiveChart.SeriesCollection(title(8)).values = drawrange
ActiveChart.SeriesCollection(title(8)).Name = Sheets("Figure").Cells(29, i + 6).value
End If
Next i
End If

Range("A1").Select
'Sheets("Figure").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

' Enable the updating of the screen
Application.ScreenUpdating = True
End Sub
Function exists(number As Integer, rows As Integer) As Boolean
Dim i As Integer
Dim e As Boolean

e = False
For i = 1 To rows
If Sheets("Figure").Cells(29 + i, number).value <> "" Then
e = True
Exit For
End If
Next i
exists = e
End Function

IF you can, help me please.
thanks a lot.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Forum statistics

Threads
1,214,667
Messages
6,120,814
Members
448,990
Latest member
rohitsomani

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top