erro 5 Неверный вызов процедуры или аргумент при формировании ячейки при создании таблицы - PullRequest
1 голос
/ 24 октября 2019

У меня появилось несколько ошибок после форматирования ячейки при создании таблицы (с использованием vba). Идея состоит в том, чтобы отформатировать первую строку при создании таблицы, после первой, я полагаю, что Excel автоматически отформатирует строку ниже с тем же типом форматирования. Ошибки отображаются в ближайшем окне (проверьте ниже в части кода для них)

Я не пытался много, в основном потому, что я не уверен, почему эта ошибка происходит. Код форматирования vba запускается только после создания таблицы, поэтому этого не может быть, потому что в это время таблицы нет. Я уже прочитал поддержку кода ошибки на https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/invalid-procedure-call-or-argument-error-5, и я не могу понять, какой аргумент я использую, что я не должен ... Если я выполняю макрос и изменяю себя вручную, он напишет очень похожую строку кода.

Immediate window
criarTabela:5:Invalid procedure call or argument
novaLinha:5:Invalid procedure call or argument
But_Adic:5:Invalid procedure call or argument
Option Explicit

Private Sub Butao_Adicionar_Click()
    On Error Resume Next
    Dim forceInput(2) As String
    Dim element As Variant
    Dim ctCheck As Boolean

    'Variaveis que indica as caixas de texto que teem ibrigatóriamente de ser preenchidas
    forceInput(0) = "Input_Nome"
    If Trim(Me.Input_Contacto2.Value) = "" Then
        forceInput(1) = "Input_Contacto1"
    Else
        forceInput(1) = "Input_Contacto1"
    End If
    forceInput(2) = IIf(Trim(Me.Input_Local.Value) = "", "Input_Local", "Input_Localidade")

    ctCheck = True

    'Forçar as caixas de texto indicadas nas variaveis acima a serem preenchidas ou o utilizador será alertádo
    For Each element In forceInput
        If Trim(Me(element).Value) = "" Then
            ctCheck = False
            Me(element).BackColor = RGB(255, 255, 0) 'Colocar a caixa de texto verde
            Worksheets("Dados").Cells(1, 1).Value = Join(forceInput, ",")
        Else
            Me(element).BackColor = RGB(255, 255, 255) 'Colocar a caixa de texto branca
        End If
    Next element

    'Se a variavel ctCheck for true chamar a sub rotina novaLinha
    If ctCheck Then
        Call novaLinha
    End If

    If Err.Number > 0 Then
        Debug.Print "But_Adic:" & Err.Number & ":" & Err.Description
    End If
End Sub

Sub novaLinha()
    On Error Resume Next
    Dim ws As Worksheet
    Set ws = Worksheets("Dados")

    If Not ws.ListObjects.Count > 0 Then
        Call criarTabela(ws)
    End If

    If ws.ListObjects.Count > 0 Then
        Dim tbl As ListObject
        Dim newrow As ListRow

        Set tbl = ws.ListObjects("TabelaDados")
        Set newrow = tbl.ListRows.Add
        With newrow
            .Range(1) = Me.Input_ID.Value
            .Range(2) = Format(Now(), "dd/mm/yyyy")
            .Range(3) = Format(Now(), "hh:mm")
            criarBt .Range(4)
            .Range(5) = Me.Input_Nome.Value
            .Range(6) = Me.Input_Contacto1.Value & "|" & Me.Input_Contacto2.Value
        End With
    End If

    If Err.Number > 0 Then
        Debug.Print "novaLinha:" & Err.Number & ":" & Err.Description
    End If
End Sub
Private Sub criarBt(cel As Range)
    Dim bt As Button

    Set bt = ActiveSheet.Buttons.Add(cel.Left, cel.Top, cel.Width, cel.Height)
    With bt
        .OnAction = "Createbutton"
        .Caption = "Hora fim"
        .Name = "HoraFim_" & cel.Row
    End With
End Sub

Sub criarTabela(ws)
    On Error Resume Next
    Dim tbl As ListObject
    Dim tCell As Range
    Dim hdrRange As Range
    Dim ctHeader() As String
    Dim headerCt As Integer

    Const HEADERS As String = "ID,Data,H. inicial,H. final,Nome,Contactos"

    ctHeader = Split(HEADERS, ",")
    headerCt = UBound(ctHeader) + 1
    ' Coloca os valores de HEADERS nas colunas designádas em hdrRange
    Set hdrRange = Range(Cells(1, 1), Cells(1, headerCt))
    hdrRange.Value = Application.Transpose(Application.Transpose(Split(HEADERS, ",")))

    ' Cria a tabela
    Set tbl = ws.ListObjects.Add(xlSrcRange, hdrRange, , xlYes)

    With tbl
        .Name = "TabelaDados"
        .TableStyle = "TableStyleMedium2"
        .Range.AutoFilter
        .Range.Cells.HorizontalAlignment = xlHAlignCenter
        .Range.Cells.VerticalAlignment = xlHAlignCenter

        .Range("TabelaDados[ID]").NumberFormat = "0"
        .Range("TabelaDados[Data]").NumberFormat = "yyyy/mm/dd"
        .Range("TabelaDados[H. inicial]").NumberFormat = "h:mm;@"
        .Range("TabelaDados[H. final]").NumberFormat = "h:mm;@"
        .Range("TabelaDados[Nome]").NumberFormat = "@"
        .Range("TabelaDados[Contactos]").NumberFormat = "General"
    End With
    If Err.Number > 0 Then
        Debug.Print "criarTabela:" & Err.Number & ":" & Err.Description
    End If
End Sub

Так как ошибки приведены в 3 подпрограммах, я помещу все 3 из них здесь. Надеюсь, это не так уж много. Идея в том, чтобы перестать давать ошибки и понять причину их возникновения.

Заранее спасибо

1 Ответ

0 голосов
/ 25 октября 2019

Мне удалось выяснить, как исправить мою проблему. Сделал также небольшой макрос для людей, чтобы проверить, если.

Однако строки, из-за которых произошла ошибка, были изменены на что-то вроде этого: .Range (2, 2) .NumberFormat = "гггг / мм/ dd "

Выше вы можете найти код теста, который я сделал

Sub makeTable()
    Dim ws As Worksheet
    Set ws = Worksheets(1)

    ws.Cells(1, 1).Value = "ID"
    ws.Cells(1, 2).Value = "Date"

    Dim tbl As ListObject
    Set tbl = ws.ListObjects.Add(xlSrcRange, Range("A1:B1"), , xlYes)

    With tbl
        .Name = "DataTable"
        .TableStyle = "TableStyleMedium2"
        .Range.AutoFilter
        .Range.HorizontalAlignment = xlHAlignCenter
        .Range.VerticalAlignment = xlHAlignCenter

        .Range(2, 1).NumberFormat = "0"
        .Range(2, 2).NumberFormat = "yyyy/mm/dd"
    End With
End Sub

Thanks for the help and some some other's gave
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...