У меня появилось несколько ошибок после форматирования ячейки при создании таблицы (с использованием 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 из них здесь. Надеюсь, это не так уж много. Идея в том, чтобы перестать давать ошибки и понять причину их возникновения.
Заранее спасибо