Excel 甘特图创建导致程序错误_Excel_Vba

Excel 甘特图创建导致程序错误

excel vba

Excel 甘特图创建导致程序错误,excel,vba,Excel,Vba,我有一个很久以前创建的VBA程序。在其原始文档中，它工作正常，并输出如下内容：但是，当我将输入表和VBA代码复制到设置完全相同的新文档时，它会给我一个运行时错误13:类型不匹配错误在写着EndTime=ActiveSheet.Cells（RowIndex，VAR5）的行中，大约是代码的一半 Public RESOL As Single Public StepRow As Integer 'this is the start ROW for the STEP numbers P

我有一个很久以前创建的VBA程序。在其原始文档中，它工作正常，并输出如下内容：

但是，当我将输入表和VBA代码复制到设置完全相同的新文档时，它会给我一个

运行时错误13:类型不匹配错误

在写着

EndTime=ActiveSheet.Cells（RowIndex，VAR5）

的行中，大约是代码的一半

Public RESOL As Single
Public StepRow As Integer       'this is the start ROW for the STEP numbers
Public StepColumn As Integer    'this is the COLUMN for the STEP numbers
Public VAR3 As Integer          'this is the COLUMN for ABSOLUTE START
Public VAR4 As Integer          'this is the COLUMN for LINK
Public VAR5 As Integer          'this is the COLUMN for DURATION
Public VAR6 As Integer          'this is the COLUMN for the first time period
Public VAR7 As Integer  '       this is the ROW for the labels
Public RowPos As Single
Public TotalTime As Single
Public x1 As Single
Public RowIndex As Integer
Public LastColumn As Integer
Public StartTime As Single
Public EndTime As Single
Public WindowSize As Single

Sub Chart()

    StepRow = 5         ' starting row for step numbers
    StepColumn = 2      ' this is the COLUMN for the STEP numbers
    VAR3 = 4            ' this is the COLUMN for ABSOLUTE START
    VAR4 = 5            ' this is the COLUMN for LINK
    VAR5 = 6            ' this is the COLUMN for DURATION
    VAR6 = 11            ' this is the COLUMN for the first time period
    VAR7 = 3            ' this is the ROW for the labels.

    RESOL = ActiveSheet.Cells(1, VAR3)

    'when the resolution to .01 if less than .01
    If RESOL < 0.01 Then
        MsgBox ("Grid resolution must be at least .01")
        Exit Sub
    End If

    LastColumn = VAR6
    TotalTime = 0
    RowIndex = StepRow
    CheckNum = 1

    Do
        x = ActiveSheet.Cells(RowIndex, StepColumn)

        ' bomb if no step number present
        If IsNumeric(x) = False Then
            MsgBox ("Couldn't find a step number at position " & CheckNum)
            Exit Sub
        End If

        If x < 1 Then
            LastNum = CheckNum - 1
            Exit Do
        End If


        If x <> CheckNum Then
            MsgBox ("Step number does not match position" & CheckNum)
            Exit Sub
        End If

        RowIndex = RowIndex + 1
        CheckNum = CheckNum + 1

    Loop

    ActiveSheet.Lines.Delete
    ActiveSheet.Range(Cells(VAR7, VAR6), Cells(VAR7, 256)).ClearContents
    Application.ScreenUpdating = False
    WindowSize = ActiveWindow.Zoom
    ActiveWindow.Zoom = 100
    RowIndex = StepRow
    CheckNum = 1

    Do
        LinkPos = ActiveSheet.Cells(RowIndex, VAR4)

        If Val(LinkPos) > LastNum Then
            MsgBox ("Illegal LINK number for step " + CheckNum)
            ActiveWindow.Zoom = WindowSize
            Application.ScreenUpdating = True
            Exit Sub
        End If

        If Val(LinkPos) < 1 Then
            ActiveSheet.Cells(RowIndex, VAR4).Formula = Empty
        End If

        If Val(LinkPos) > 0 And Val(LinkPos) <= LastNum Then
            ActiveSheet.Cells(RowIndex, VAR3).Formula = "NA"
        End If

        If CheckNum = LastNum Then
            Exit Do
        End If

        CheckNum = CheckNum + 1
        RowIndex = RowIndex + 1

    Loop

    CompletedSteps = 0
    RowIndex = StepRow
    CheckNum = 1

    Do
        AbsPos = ActiveSheet.Cells(RowIndex, VAR3)

        If AbsPos <> "NA" And IsNumeric(AbsPos) = True Then
            StartTime = Val(AbsPos)
            EndTime = ActiveSheet.Cells(RowIndex, VAR5)
            EndTime = EndTime + StartTime
            Run ("DrawLine")
            CompletedSteps = CompletedSteps + 1
        End If

        If CheckNum = LastNum Then
            Exit Do
        End If

        CheckNum = CheckNum + 1
        RowIndex = RowIndex + 1
    Loop

    NoOfTries = 1

    Do

        If CompletedSteps = LastNum Then
            Exit Do
        End If

        RowIndex = StepRow
        CheckNum = 1

        Do
            LinkTo = ActiveSheet.Cells(RowIndex, VAR4)

            If Val(LinkTo) >= 1 And Val(LinkTo) <= LastNum Then

                AbsPos = ActiveSheet.Cells(StepRow - 1 + LinkTo, VAR3)

                If AbsPos <> "NA" And IsNumeric(AbsPos) = True Then
                    DurPos = ActiveSheet.Cells(StepRow - 1 + LinkTo, VAR5)
                    AbsPos = AbsPos + DurPos
                    StartTime = Val(AbsPos)
                    EndTime = ActiveSheet.Cells(RowIndex, VAR5)
                    EndTime = EndTime + StartTime
                    ActiveSheet.Cells(RowIndex, VAR3).Formula = StartTime
                    Run ("DrawLine")
                    Top1 = ActiveSheet.Cells(StepRow - 1 + LinkTo, VAR6).Top
                    Top2 = ActiveSheet.Cells(StepRow + LinkTo, VAR6).Top
                    RowPos2 = Top1 + ((Top2 - Top1) / 2)

                    Set mySheet = ActiveSheet
                    With mySheet.Shapes.AddLine(x1, RowPos, x1, RowPos2).Line
                        .DashStyle = msoLineDash
                        .ForeColor.RGB = RGB(0, 0, 0)
                    End With

                    CompletedSteps = CompletedSteps + 1

                End If

            End If

            If CheckNum = LastNum Then
                Exit Do
            End If

            CheckNum = CheckNum + 1
            RowIndex = RowIndex + 1

        Loop

        If NoOfTries = LastNum Then
            Exit Do
        End If

        NoOfTries = NoOfTries + 1
    Loop

    RowIndex = StepRow
    CheckNum = 1

    Do
        LinkPos = ActiveSheet.Cells(RowIndex, VAR4)
        If Val(LinkPos) > 0 And Val(LinkPos) <= LastNum Then
            ActiveSheet.Cells(RowIndex, VAR3).Formula = Empty
        End If

        If CheckNum = LastNum Then
            Exit Do
        End If

        CheckNum = CheckNum + 1
        RowIndex = RowIndex + 1
    Loop

    CheckCol = VAR6
    ColVal = RESOL

    Do
        ActiveSheet.Cells(VAR7, CheckCol).Formula = ColVal

        If CheckCol >= LastColumn Then
            Exit Do
        End If

        ColVal = ColVal + RESOL
        CheckCol = CheckCol + 1
    Loop

    ActiveSheet.Cells(2, VAR3).Formula = TotalTime
    Range("A1").Select
    ActiveWindow.Zoom = WindowSize
    Application.ScreenUpdating = True

End Sub

Sub Drawline()
    If EndTime > TotalTime Then
        TotalTime = EndTime
    End If

    Top1 = ActiveSheet.Cells(RowIndex, VAR6).Top
    Top2 = ActiveSheet.Cells(RowIndex + 1, VAR6).Top
    RowPos = Top1 + ((Top2 - Top1) / 2)
    CheckCol = VAR6
    ColTime = 0

    Do
        x1 = ActiveSheet.Cells(RowIndex, CheckCol).Left

        If ColTime = StartTime Then
            Exit Do
        End If

        If ColTime > StartTime Then
            x2 = ActiveSheet.Cells(RowIndex, CheckCol - 1).Left
            Span = x1 - x2
            Differencial = (ColTime - StartTime) / RESOL
            TimeOffset = Differencial * Span
            x1 = x1 - TimeOffset
            Exit Do
        End If

        ColTime = ColTime + RESOL
        CheckCol = CheckCol + 1

    Loop

    CheckCol = VAR6
    ColTime = 0

    Do
        y1 = ActiveSheet.Cells(RowIndex, CheckCol).Left

        If ColTime = EndTime Then
            Exit Do
        End If

        If ColTime > EndTime Then
            y2 = ActiveSheet.Cells(RowIndex, CheckCol - 1).Left
            Span = y1 - y2
            Differencial = (ColTime - EndTime) / RESOL
            TimeOffset = Differencial * Span
            y1 = y1 - TimeOffset
            Exit Do
        End If

        ColTime = ColTime + RESOL
        CheckCol = CheckCol + 1

    Loop

    If CheckCol > LastColumn Then
        LastColumn = CheckCol
    End If

    Set mySheet = ActiveSheet
    With mySheet.Shapes.AddLine(x1, RowPos - 2, y1, RowPos - 2).Line
        .DashStyle = msoLineSolid
        .ForeColor.RGB = RGB(128, 0, 25)
         .Weight = xlHairline
    End With

    With mySheet.Shapes.AddLine(x1, RowPos, y1, RowPos).Line
        .DashStyle = msoLineSolid
        .ForeColor.RGB = RGB(128, 0, 25)
        .Weight = xlThick
    End With

    With mySheet.Shapes.AddLine(x1, RowPos + 2, y1, RowPos + 2).Line
        .DashStyle = msoLineSolid
        .ForeColor.RGB = RGB(128, 0, 25)
        .Weight = xlHairline
    End With


End Sub

Public RESOL作为单一
Public StepRow As Integer'这是步骤编号的起始行
Public StepColumn As Integer'这是步骤编号的列
Public VAR3 As Integer'这是绝对开始的列
Public VAR4 As Integer'这是链接的列
Public VAR5 As Integer'这是持续时间的列
Public VAR6 As Integer'这是第一个时间段的列
Public VAR7 As Integer'这是标签的行
公共RowPos作为单个
单一公共总时间
公共x1作为单个
作为整数的公共行索引
作为整数的公共列
公共启动时间为单身
公共结束时间为单个
公共窗口大小为单个
子图（）
步骤行=步骤编号的5'起始行
StepColumn=2'这是步骤编号的列
VAR3=4'这是绝对开始的列
VAR4=5'这是链接的列
VAR5=6'这是持续时间的列
VAR6=11'这是第一个时间段的列
VAR7=3'这是标签的行。
RESOL=ActiveSheet.Cells（1，VAR3）
'如果小于.01，则分辨率为.01
如果RESOL<0.01，则
MsgBox（“网格分辨率必须至少为.01”）
出口接头
如果结束
LastColumn=VAR6
总时间=0
RowIndex=StepRow
CheckNum=1
做
x=ActiveSheet.Cells（行索引、步列）
'如果没有步骤编号，则轰炸
如果IsNumeric（x）=False，则
MsgBox（“在位置处找不到步骤号”&CheckNum）
出口接头
如果结束
如果x<1，则
LastNum=CheckNum-1
退出Do
如果结束
如果x CheckNum那么
MsgBox（“步骤编号与位置不匹配”&CheckNum）
出口接头
如果结束
行索引=行索引+1
CheckNum=CheckNum+1
环
ActiveSheet.Lines.Delete
范围（单元格（VAR7，VAR6），单元格（VAR7，256））.ClearContents
Application.ScreenUpdating=False
WindowSize=ActiveWindow.Zoom
ActiveWindow.Zoom=100
RowIndex=StepRow
CheckNum=1
做
LinkPos=ActiveSheet.Cells（行索引，VAR4）
如果Val（LinkPos）>LastNum，则
MsgBox（“步骤的非法链接编号”+CheckNum）
ActiveWindow.Zoom=WindowSize
Application.ScreenUpdating=True
出口接头
如果结束
如果Val（LinkPos）<1，则
ActiveSheet.Cells（RowIndex，VAR4）。公式=空
如果结束
如果Val（LinkPos）>0且Val（LinkPos）=1且Val（LinkTo）0且Val（LinkPos）=最后一列，则
退出Do
如果结束
ColVal=ColVal+RESOL
CheckCol=CheckCol+1
环
ActiveSheet.Cells（2，VAR3）。公式=总时间
范围（“A1”）。选择
ActiveWindow.Zoom=WindowSize
Application.ScreenUpdating=True
端接头
副抽绳（）
如果EndTime>TotalTime，则
总时间=结束时间
如果结束
Top1=ActiveSheet.Cells（行索引，VAR6）。Top
Top2=ActiveSheet.Cells（行索引+1，VAR6）。顶部
RowPos=Top1+（（Top2-Top1）/2）
CheckCol=VAR6
ColTime=0
做
x1=ActiveSheet.Cells（行索引，检查列）。左侧
如果ColTime=StartTime，则
退出Do
如果结束
如果ColTime>StartTime，则
x2=ActiveSheet.Cells（行索引，检查列-1）。左侧
Span=x1-x2
微分=（ColTime-StartTime）/分辨率
时间偏移=差*跨度
x1=x1-时间偏移
退出Do
如果结束
ColTime=ColTime+RESOL
CheckCol=CheckCol+1
环
CheckCol=VAR6
ColTime=0
做
y1=ActiveSheet.Cells（行索引，检查列）。左侧
如果ColTime=EndTime，则
退出Do
如果结束
如果ColTime>EndTime，则
y2=ActiveSheet.Cells（行索引，检查列-1）。左
跨度=y1-y2
微分=（ColTime-EndTime）/分辨率
时间偏移=差*跨度
y1=y1-时间偏移
退出Do
如果结束
ColTime=ColTime+RESOL
CheckCol=CheckCol+1
环
如果选中Col>LastColumn，则
LastColumn=CheckCol
如果结束
设置mySheet=ActiveSheet
使用mySheet.Shapes.AddLine（x1，行位置-2，y1，行位置-2）.Line
.DashStyle=msoLineSolid
.ForeColor.RGB=RGB（128,0,25）
.Weight=xl发际线
以
使用mySheet.Shapes.AddLine（x1，RowPos，y1，RowPos）.Line
.DashStyle=msoLineSolid
.ForeColor.RGB=RGB（128,0,25）
.重量=xl厚
以
使用mySheet.Shapes.AddLine（x1，行位置+2，y1，行位置+2）.Line
.DashStyle=msoLineSolid
.ForeColor.RGB=RGB（128,0,25）
.Weight=xl发际线
以
端接头

任何帮助都将不胜感激。我把两个文档设置得完全一样，所以我不明白为什么它只处理一个，而不处理另一个

编辑：下面是文档出错时的状态。它在“开始时间”列中添加了所有“NA”，但在原始工作表中没有这样做

当我注释掉错误时，它会工作，但会打印以下内容，其中甘特图下方有实心条，起始条是实心条

检查该单元格中的值-i