Как исправить подстрочный индекс вне диапазона в этом коде - PullRequest
0 голосов
/ 28 марта 2019

Я работаю с пользовательской формой для добавления данных в таблицу "t_database". Для каждого флажка = true, добавьте строку. Когда я добавляю некоторые данные, появляется сообщение «Ошибка времени выполнения» 9 'Подстрочный индекс вне диапазона.

Для создания этого кода я использовал пост, основанный здесь, и завершил свои требования.

Option Explicit
Private Sub cmdAddproject_Click()
Dim chkCnt As Integer
Dim ctl As MSForms.Control, i As Integer, lr As Long
Dim cb As MSForms.CheckBox

With Me
    chkCnt = .Tool1.Value + .Tool2.Value + .Tool3.Value + .Tool4.Value + .Tool5.Value + .Tool6.Value + .Tool7.Value + .Tool8.Value + .Tool9.Value + .Tool10.Value + .Tool11.Value + .Tool12.Value + .Tool13.Value + .Tool14.Value + .Tool15.Value + .Tool16.Value + .Tool7.Value + .Tool18.Value + .Tool19.Value + .Tool20.Value + .Tool21.Value + .Tool22.Value + .Tool23.Value + .Tool24.Value + .Tool25.Value + .Tool26.Value + .Tool27.Value + .Tool28.Value + .Tool29.Value + .Tool30.Value
    chkCnt = Abs(chkCnt)

    If chkCnt <> 0 Then
        ReDim mval(1 To chkCnt, 1 To 17)
        i = 1

        For Each ctl In .Controls
            If TypeOf ctl Is MSForms.CheckBox Then
                Set cb = ctl
                If cb Then
                    mval(i, 1) = .txtProyecto.Value
                    mval(i, 2) = .txtAno.Value
                    mval(i, 3) = .txtEmpresa.Value
                    mval(i, 4) = .SectorEmpresa.Value
                    mval(i, 5) = .TipoEmpresa.Value
                    mval(i, 6) = .txtDireccion.Value
                    mval(i, 7) = .txtCiudad.Value
                    mval(i, 8) = .txtCodigoPostal.Value
                    mval(i, 9) = .txtPais.Value
                    mval(i, 10) = .txtDescripcion.Value
                    mval(i, 11) = .txtIndicador1.Value
                    mval(i, 12) = .metrica1.Value
                    mval(i, 13) = .txtIndicador2.Value
                    mval(i, 14) = .metrica2.Value
                    mval(i, 15) = cb.Caption
                    mval(i, 16) = .txtAhorrosPrevistos.Value
                    mval(i, 17) = .txtAhorrosObtenidos.Value
                    i = i + 1
                End If
            End If
        Next
    End If
End With

With Sheets("Database")
    lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    .Range("A" & lr).Resize(UBound(mval, 1), 17) = mval
End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...