Error run-time 70 - autorizzazione negata

Question

Ciao a tutti, nel dare esecuzione al mio codice commandbutton1 (Aggiungi) mi viene fuori l'errore debug

UserForm4.ListBox1.AddItem Trim(rowData)

il file https://www.dropbox.com/scl/fi/0ldnbabcj8anb32gxtium/Prova.xlsm?rlkey=1ezho1t3teu08l24zemaha6pf&dl=0 il codice

Private Sub CommandButton1_Click() 'aggiungi

Dim ws As Worksheet 

' Imposta il foglio di lavoro attivo 

Set ws = ActiveSheet 

' Controlla se il foglio attivo è Foglio1 o Foglio2 

If ws.Name = "Foglio1" Or ws.Name = "Foglio2" Then 

    Dim i As Integer 

    Dim dataRange As Range 

    Set dataRange = ws.Range("B5:I9") 'ultima riga di dati 

    Dim newRow As Long 

    newRow = FindEmptyRow(ws, 2) cercare la riga vuota 

    If newRow = 0 Then 

        MsgBox "Il range è pieno. Impossibile aggiungere nuovi dati.", vbExclamation 

        Exit Sub 

    End If 

    If IsDuplicate(ws, dataRange, newRow) Then 

        Exit Sub ' Esce se trova un duplicato 

    End If 

    ' Assegna i valori alle celle nella nuova riga 

    ws.Cells(newRow, 2).Value = CDbl(UserForm4.TextBox1.Text) ' TextBox1 è numerico (CDbl) 

    ws.Cells(newRow, 3).Value = UserForm4.TextBox2.Text ' TextBox2 è testo 

    ws.Cells(newRow, 4).Value = UserForm4.TextBox3.Text ' TextBox3 è testo 

    ws.Cells(newRow, 5).Value = CDate(UserForm4.TextBox4.Text) ' TextBox4 è una data (CDate) 

    ws.Cells(newRow, 6).Value = CDbl(UserForm4.TextBox5.Text) ' TextBox5 è numerico (CDbl) 

    ws.Cells(newRow, 7).Value = CDbl(UserForm4.TextBox6.Text) ' TextBox6 è numerico (CDbl) 

    ws.Cells(newRow, 8).Value = CDbl(UserForm4.TextBox7.Text) ' TextBox7 è numerico (CDbl) 

    ws.Cells(newRow, 9).Value = UserForm4.TextBox8.Text ' TextBox8 è testo 

    ' Aggiorna la ListBox 

    Dim rowData As String 

    For i = 1 To 8 

        rowData = rowData & UserForm4.Controls("TextBox" & i).Text & vbTab 

    Next i 

    UserForm4.ListBox1.AddItem Trim(rowData)  <===errore

End If 

End Sub

saluti Massimo

Answer 1

Ciao Massimo.

Per mantenere le intestazioni del controllo ListBox, che richiede l'uso della proprietà RowSource del controllo, ho modificato il codice originale nel file che hai caricato.

Questa modifica del codice rappresenta il minimo indispensabile per garantirne la funzionalità e consente l'aggiunta, la cancellazione e la modifica di righe di dati ma non dovrebbe essere considerata in alcun modo esaustiva.

Potresti scaricare il mio file di prova Massimo (RowSource) 20240111.xlsm

Per visualizzare le varie modifiche al codice, ti suggerisco di confrontare il codice nel mio file di prova con quello nel tuo file originale.

===

Regards,

Norman

Answer 2

Ciao Massimo,

Ciao Norman,

grazie.

se applico il tuo suggerimento accade questo:

Perdo l'intestazione delle colonne nella listbox1

Una soluzione sarebbe di utilizzare una seconda controllo ListBox, sopra il controllo ListBox1, per visualizzare le intestazioni e disabilitarlo. In alternativa, forse prendi in considerazione l'utilizzo dei controlli Label sopra il controllo ListBox.

Se elimino un record , la listbox non si aggiorna, ma sul voglio viene eliminato.

Ho modificato la tua procedura CommandButton2_Click per ricaricare il controllo ListBox1, sempre sfruttando la sua proprietà List

Se aggiungo record mi dice ws.Cells(newRow, 5).Value = CDate(UserForm4.TextBox4.Text) ' TextBox4 è una data (CDate) dato non corrispondente e il codice si blocca e la riga viene compilata a metà

Ho modificato le tu procedura CommandButton1_Click per ricaricare il controllo ListBox1, di nuovo sfruttando la sua proprietà List

Tieni presente che ho esaminato solo molto frettolosamente l'altro tuo codice, limitandomi in questo momento a fornire la funzionalità richiesta senza eliminare codice potenzialmente ridondante.

Potresti scaricare il mio file di prova Massimo20240110.xlsm con il codice aggiornato.

===

Regards,

Norman

Answer 3

Ciao Norman,

grazie.

se applico il tuo suggerimento accade questo:

Perdo l'intestazione delle colonne nella listbox1

Se elimino un record , la listbox non si aggiorna, ma sul voglio viene eliminato.

Se aggiungo record mi dice ws.Cells(newRow, 5).Value = CDate(UserForm4.TextBox4.Text) ' TextBox4 è una data (CDate) dato non corrispondente e il codice si blocca e la riga viene compilata a metà

Answer 4

Ciao Massimo,

Avendo ora scaricato il tuo file, il mio suggerimento sarebbe di sostituire la tua istruzione

        **.RowSource = ws.Name & "!B5:I9"**

con:

         **.List = ws.Range("B5:I9").Value**  

===

Regards,

Norman

Answer 5

Ciao Massimo,

Ciao a tutti, nel dare esecuzione al mio codice commandbutton1 (Aggiungi) mi viene fuori l'errore debug

UserForm4.ListBox1.AddItem Trim(rowData)

il file https://www.dropbox.com/scl/fi/0ldnbabcj8anb32gxtium/Prova.xlsm?rlkey=1ezho1t3teu08l24zemaha6pf&dl=0 il codice

Private Sub CommandButton1_Click() 'aggiungi

Dim ws As Worksheet

' Imposta il foglio di lavoro attivo

Set ws = ActiveSheet

' Controlla se il foglio attivo è Foglio1 o Foglio2

If ws.Name = "Foglio1" Or ws.Name = "Foglio2" Then

Dim i As Integer

Dim dataRange As Range

Set dataRange = ws.Range("B5:I9") 'ultima riga di dati

Dim newRow As Long

newRow = FindEmptyRow(ws, 2) cercare la riga vuota

If newRow = 0 Then

MsgBox "Il range è pieno. Impossibile aggiungere nuovi dati.", vbExclamation

Exit Sub

End If

If IsDuplicate(ws, dataRange, newRow) Then

Exit Sub ' Esce se trova un duplicato

End If

' Assegna i valori alle celle nella nuova riga

ws.Cells(newRow, 2).Value = CDbl(UserForm4.TextBox1.Text) ' TextBox1 è numerico (CDbl)

ws.Cells(newRow, 3).Value = UserForm4.TextBox2.Text ' TextBox2 è testo

ws.Cells(newRow, 4).Value = UserForm4.TextBox3.Text ' TextBox3 è testo

ws.Cells(newRow, 5).Value = CDate(UserForm4.TextBox4.Text) ' TextBox4 è una data (CDate)

ws.Cells(newRow, 6).Value = CDbl(UserForm4.TextBox5.Text) ' TextBox5 è numerico (CDbl)

ws.Cells(newRow, 7).Value = CDbl(UserForm4.TextBox6.Text) ' TextBox6 è numerico (CDbl)

ws.Cells(newRow, 8).Value = CDbl(UserForm4.TextBox7.Text) ' TextBox7 è numerico (CDbl)

ws.Cells(newRow, 9).Value = UserForm4.TextBox8.Text ' TextBox8 è testo

' Aggiorna la ListBox

Dim rowData As String

For i = 1 To 8

rowData = rowData & UserForm4.Controls("TextBox" & i).Text & vbTab

Next i

UserForm4.ListBox1.AddItem Trim(rowData) <===errore

End If

End Sub

Il tuo errore verrebbe riscontrato se il controllo ListBox fosse stato caricato utilizzando la relativa proprietà RowSource.

Prova invece a eliminare l'assegnazione RowSource e caricare il controllo ListBox utilizzando la sua proprietà List con qualcosa del genere:

'========>>

Option Explicit

'-------->>

Private Sub UserForm_Initialize()

Me.ListBox1.List = ActiveSheet.Range("A1:A10").Value                     **'<<=== Modifica**

End Sub

'<<========

===

Regards,

Norman