none
Autorizzazione negata per rinominare shapes in excel RRS feed

  • Domanda

  • Buonasera.

    Sto rifacendo daccapo un programmino per emettere fatturazione elettronica.

    Sto trovando difficoltà a capire perché esca l'errore "Autorizzazione negata" quando rinomino i pulsanti presenti all'interno di una cella di excel.

    Dopo vari tentativi ho capito che per i pulsanti inseriti manualmente dal menù "controlli moduli" la procedura VBA li rinomina, se gli stessi pulsanti li inserisco tramite una macro, mi esce l'errore.

    La macro per inserire i pulsanti è la seguente:

    Public Sub Add(TypeButton As String)
    Dim Riga As Integer
    Riga = Row + 1
    
    If TypeButton = "+" Then
        NameButton = Format(Riga, "000") & " CAU +"
        NameButton = "000 CAU +"
        
        ActiveSheet.Buttons.Add(Range("A" & Riga).Left, Range("A" & Riga).Top, 24, 15).Name = NameButton
        ActiveSheet.Shapes.Range(Array(NameButton)).Select
        Selection.Caption = "+"
        Selection.OnAction = "AggiungiCausale"
    End If
    
    If TypeButton = "-" Then
        NameButton = Format(Riga, "000") & " CAU -"
        NameButton = "000 CAU -"
        ActiveSheet.Buttons.Add(Range("A" & Riga).Left + 24, Range("A" & Riga).Top, 24, 15).Name = NameButton
        ActiveSheet.Shapes.Range(Array(NameButton)).Select
        Selection.Caption = "-"
        Selection.OnAction = "CancellaCausale"
    End If
    
    Call Renumber
    End Sub
    

    mentre per rinominare i pulsanti uso il seguente codice


    Private Sub Renumber() Dim Conta As Integer Dim TypeButton As String Dim Numerazione As String TypeButton = "CAU" Conta = 0 Dim Foglio As Worksheet Set Foglio = Application.ActiveSheet TotaleForme = Foglio.Shapes.Count For x = 1 To TotaleForme If Foglio.Shapes(x).Type = msoFormControl Then NameButton = Foglio.Shapes(x).Name Button = Mid(NameButton, 5, 3) If UCase(Button) = TypeButton Then Conta = Conta + 1 Numerazione = Format(Conta, "000") Estensione = Right(Foglio.Shapes(x).Name, 5) NewNameButton = Numerazione & " " & Estensione Foglio.Shapes(x).Name = NewNameButton End If End If Next x End Sub

    Giusto per far non lasciar nulla al caso, la macro funziona per i primi 3 pulsanti inseriti a mano, ma quando inserisco un nuovo pulsante tramite il primo segmento di codice e si avvia la sub renumber genera "Autorizzazione negata".

    Ho provato anche a deselezionare il pulsante dopo la fase di creazione pensando che il "focus" potesse dargli fastidio, ma l'effetto è stato vano. 

    Per ora ho risolto selezionando fisicamente il pulsante tramite il comando ActiveSheet.Shapes.Range(Array(NameButton)).Select

    ma vedere che vengano selezionati i pulsanti durante la fase di rinomina non è che sia proprio professionale.

    Chiedo una mano a chi di voi è più esperto a farmi luce. Grazie. 

    Se dovesse servire posso postare anche il file intero. 

    sabato 4 luglio 2020 21:40

Risposte

Tutte le risposte

  • Ho provato le tue macro su un nuovo foglio e non rilevo alcun problema su Excel 2010
    • Contrassegnato come risposta SIEM srl domenica 5 luglio 2020 12:39
    domenica 5 luglio 2020 06:19
  • Ma che strano!!! 

    Uso la versione 365. Provo anch'io sulla versione 2010 magari funziona.

    Grazie per ora patel45

    domenica 5 luglio 2020 09:55
  • Ho risolto cambiando algoritmo. Anziché rinominare tutti i pulsanti ogni volta che ne aggiungo o ne rimuovo uno, eseguo un ciclo per vedere se ne esiste uno con lo stesso numero sequenziale.

    Viene un lavoro più pulito e il codice è molto più semplice.

    Per inserire il pulsante all'interno di una cella di Excel (Row è una sub che restituisce la riga del pulsante premuto):  

    Public Sub Add(TypeButton As String)
    Dim Riga As Integer
    Riga = Row + 1
    
    NameButton = FoundNewNumber(TypeButton)
    
    If TypeButton = "+" Then
        ActiveSheet.Buttons.Add(Range("A" & Riga).Left, Range("A" & Riga).Top, 24, 15).Name = NameButton
        ActiveSheet.Shapes.Range(Array(NameButton)).Select
        Selection.Caption = "+"
        Selection.OnAction = "AggiungiCausale"
    End If
    
    If TypeButton = "-" Then
        ActiveSheet.Buttons.Add(Range("A" & Riga).Left + 24, Range("A" & Riga).Top, 24, 15).Name = NameButton
        ActiveSheet.Shapes.Range(Array(NameButton)).Select
        Selection.Caption = "-"
        Selection.OnAction = "CancellaCausale"
    End If
    
    End Sub

    Una function che mi cerca il primo numero disponibile per un nuovo pulsante:

    Private Function FoundNewNumber(TypeButton As String)
    
    Dim Conta As Integer: Conta = 1
    Dim Button As String: Button = "CAU"
    Dim NameButton As String
    
    Dim Foglio As Worksheet
    Set Foglio = Application.ActiveSheet
    TotaleForme = Foglio.Shapes.Count
    
    Do
        ' Costruisci il nome del pulsante
        Conta = Conta + 1
        NameButton = Format(Conta, "000") & " " & Button & " " & TypeButton
        ' Incrementa la numerazione finchè il nome non diventa univoco
    Loop While PBisExist(NameButton) = True
    
    FoundNewNumber = NameButton
    
    End Function


    Ed infine una function che mi restituisce vero/falso a seconda che abbia trovato o meno il nome di un pulsante esistente:

    Private Function PBisExist(NameButton As String) As Boolean
    
    Dim Foglio As Worksheet
    Set Foglio = Application.ActiveSheet
    TotaleForme = Foglio.Shapes.Count
    
    For x = 1 To TotaleForme
        NameShape = Foglio.Shapes(x).Name
        If NameShape = NameButton Then
            PBisExist = True
            Exit Function
        End If
    Next x
    
    PBisExist = False
    
    End Function

    Se dovesse mai servire a qualcuno!!!

    Grazie Patel45 per il tuo contributo.


    • Modificato SIEM srl domenica 5 luglio 2020 16:42
    • Proposto come risposta patel45 lunedì 6 luglio 2020 06:15
    domenica 5 luglio 2020 12:50