错误栏的问题似乎已解决，但现在我收到错误 5。错误行是：
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=False, LegendKey:=False, ShowSeriesName:=False, ShowCategoryName:=False, ShowValue:=True, _ ShowPercentage:=False, ShowBubbleSize:=False
'resize chart
WS.ChartObjects(1).Width = 500
WS.ChartObjects(1).Height = chartmultipl * (rowcnt - 1 - minscale)
WS.ChartObjects(1).Left = chartleftpos
WS.ChartObjects(1).Top = 70
'Rescale values to positions in chart so that labels can be succesfully moved
minchar = ActiveChart.Axes(xlCategory).MinimumScale
maxchar = ActiveChart.Axes(xlCategory).MaximumScale
midchar = (maxchar + minchar) / 2
'datalabels
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=False, LegendKey:=False, ShowSeriesName:=False, ShowCategoryName:=False, ShowValue:=True, _
ShowPercentage:=False, ShowBubbleSize:=False
For i = 1 To rowcnt - 1
If WS.Cells(i + 1, labelcol) <> "" Then
With ActiveChart.SeriesCollection(1).Points(i).DataLabel
.Characters.Text = Left(WS.Cells(i + 1, labelcol).Value, 28)
.AutoScaleFont = False
With .Characters(Start:=1, Length:=100).Font
.Name = "Arial"
If WS.Cells(i + 1, labelcol).Font.Italic = True Then
.FontStyle = "Italic"
ElseIf WS.Cells(i + 1, labelcol).Font.Bold = True Or Not ptype Then
.FontStyle = "Bold"
Else
.FontStyle = "Normal"
End If
.Size = labelsize
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'move labels wherever there is enough space to display them or to the beginning of the graph
If ptype Then
textsize = Application.WorksheetFunction.Min(Len(WS.Cells(i + 1, labelcol).Value), 28)
If WS.Cells(i + 1, int1).Value <= midchar Then
.Left = 15 + Round(ActiveChart.PlotArea.Width * (WS.Cells(i + 1, 6).Value - minchar) / (maxchar - minchar))
Else
.Left = -textsize * 3 + Round(ActiveChart.PlotArea.Width * (WS.Cells(i + 1, 5).Value - minchar) / (maxchar - minchar))
End If
Else
.Left = 20
End If
End With
End If
Next i
'if it's an outcome graph use set square sizes, if a final MA graph use study weights
If Not ptype Then
For i = 1 To resultcount
With ActiveChart.SeriesCollection(1).Points(i)
.MarkerSize = Round(sqsize(i), 0)
End With
Next i
End If
'send chart to back for future merging
WS.ChartObjects(1).SendToBack
'ActiveChart.ChartArea.Select
'Selection.ShapeRange.ZOrder msoSendToBack
'deselect graph so that I can add the rest of the shapes but first save things that are needed
minsc = ActiveChart.Axes(xlCategory).MinimumScale
maxsc = ActiveChart.Axes(xlCategory).MaximumScale
WS.Range("A1").Select
'if it is the final scatterplot add the diamonds
If Not ptype Then
Dim plarealeft, plarearight As Double
Dim dheight, incrh As Double
Dim origleft, origlength, transleft As Double
Dim diampos, diamlength As Double
Dim grtop As Double
'left and right edge of plot area in pixels
plarealeft = 371
plarearight = 827
'diamond statistics
dheight = 10
'vertical alignment of diamonds - increment from one to another
incrh = WS.ChartObjects(1).Height / ((rowcnt - 1) - minscale + 2)
'top of the graph
grtop = WS.ChartObjects(1).Top
'get all info in tables so that I can use in loops
mu(1) = fe_mu
mu(2) = dl_mu
mu(3) = ml_mu
mu(4) = pl_mu
mu(5) = T_mu
mvar(1) = fe_var
mvar(2) = dl_var
mvar(3) = ml_var
mvar(4) = pl_var
mvar(5) = T_var
For i = 1 To 4
tmargin(i) = 1.96
Next i
tmargin(5) = Excel.WorksheetFunction.TInv(0.05, resultcount - 1)
tlabel(1) = "FE"
tlabel(2) = "DL"
tlabel(3) = "ML"
tlabel(4) = "PL"
tlabel(5) = "T"
'go through all 5 diamonds
For i = 1 To 5
'original length and far left position
origleft = mu(i) - tmargin(i) * (mvar(i) ^ (1 / 2))
origlength = 2 * tmargin(i) * (mvar(i) ^ (1 / 2))
'transform to [0,1] scale
transleft = (origleft - minsc) / (maxsc - minsc)
'transform to points
diampos = plarealeft + (plarearight - plarealeft) * transleft + 1
diamlength = (plarearight - plarealeft) * origlength / (maxsc - minsc)
ActiveSheet.Shapes.AddShape(msoShapeDiamond, diampos, grtop + (rowcnt - 1.5 + i + 1) * incrh - dheight / 2, diamlength, dheight).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, diampos + diamlength + 10, grtop + (rowcnt - 1.5 + i + 1) * incrh - dheight / 2, 20, 12).Select
Selection.Characters.Text = tlabel(i)
With Selection.ShapeRange
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 9
End With
Next i
End If
'add text files with study information
If ptype Then
tboxend = rowcnt * 10
tboxstep = (tboxend - 80) / (rowcnt - 2)
For i = 2 To rowcnt
If (WS.Cells(i, 1).Value <> "" And WS.Cells(i - 1, 1).Value = "") Or i = 2 Then
'find how many outcomes there are in each study to better align the text boxes
j = i
Do
j = j + 1
Loop Until WS.Cells(j, 1).Value = ""
cntr = j - i
'create textbox
tboxpos = tboxend - (i - 2) * tboxstep - (cntr - 1) * tboxstep / 2
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 500, tboxpos, 60, 25).Select
Selection.Characters.Text = WS.Cells(i, 1).Value
With Selection.ShapeRange
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End If
Next i
End If
'create a list with all the shapes that need to be selected and group them
j = 0
For Each Sh In WS.Shapes
If Not Left(Sh.Name, 7) = "Comment" Then
j = j + 1
ReDim Preserve sharray(j)
sharray(j) = Sh.Name
End If
Next Sh
WS.Shapes.Range(sharray).Group
'deselect shape
WS.Range("A1").Select
Application.ScreenUpdating = True
结束子