错误栏的问题似乎已得到解决，但现在我得到一个错误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
End Sub
答案 0 :(得分：1)
首先要做的是，帮助追踪错误是正确定义所有变量。
示例：您的第一行
Dim rowcnt, textsize, cntr, labeltop As Integer
实际上与此相同：
Dim rowcnt as Variant
Dim textsize as Variant
dim cntr as Variant
dim labeltop As Integer
这样做可能会带来其他错误，可以帮助您找出导致线路失败的原因
答案 1 :(得分：0)
在代码顶部声明Option Explicit，它会通过强制您声明所有变量并帮助您更轻松地识别错误来帮助您编写更好的代码。
这可能导致您的无效呼叫或参数错误：
'get the last row of data
rowcnt = LASTINCOLUMN2(6, k)
除非您有一个名为LASTINCOLUMN2的自定义函数，否则您没有发布？
要使用最后一行：
rowcnt = WS.Range("B" & Rows.Count).End(xlUp).Row
将rowcnt声明为Long而不是integer。
您需要定义：
ptype
resultcount
vareffects
编辑：我仍在运行您的代码并识别许多未识别的子/功能。这段代码还有第二部分吗？