VBA: aggiungere un pulsante Active X su più fogli

[draleo]

Ho 8 file, ognuno con 13 fogli. Su ogni foglio dovrei:
1)aggiungere un pulsante Active X, con queste proprietà
caption; “Liste Libere” (Font Calibri, grassetto 14)
height:33
left: 250
top :117
width 107
2)assegnare ad ognuno di questi pulsante la stessa macro ( Sub CopiaFiltro_Libero) già presente in un modulo del file

Fare tali operazioni manualmente un 100io di volte mi annoierebbe…. Alquanto.
Si può realizzare in automatico (almeno in parte) ?
Grazie
draleo

[Norman Jones]

Ciao Draleo,

In un modulo di codice standard, incolla il seguente codice:
'=========>>
Option Explicit

'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim OleObj As OLEObject
Dim sCode As String

Const sCaption As String = "Liste Libere"
Const sButtonName = "Liste_Libere"

Set WB = ActiveWorkbook
For Each SH In WB.Worksheets
With SH
Set OleObj = SH.OLEObjects.Add( _
ClassType:="Forms.CommandButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=33, _
Top:=117, _
Width:=107, _
Height:=33)
End With

With OleObj
.Name = sButtonName
With .Object
.Caption = sCaption
With .Font
.Name = " Calibri"
.Bold = True
.Size = 14
End With
End With
End With

sCode = "Private Sub " & sButtonName & "_Click()" & vbNewLine
sCode = sCode & " Call CopiaFiltro_Libero" & vbCrLf
sCode = sCode & "End Sub"

With WB.VBProject.VBComponents(SH.Name).CodeModule
.insertlines .CountOfLines + 1, sCode
End With
Next SH
End Sub
'<<=========

Il codice sopra aggiungerà un CommandButton a ciascun foglio della
cartella di lavoro attualmente attiva e creerà il codice richiesto per
chiamare la macro esistente CopiaFiltro_Libero



===
Regards,
Norman

[Norman Jones]

On 30/06/2018 09:09, Norman Jones wrote:
>                        Left:=33, _

In conformità con la tua richiesta, questo avrebbe dovuto essere:
Left:=250, _



===
Regards,
Norman

[draleo]

grazie. crea il primo command button sul foglio1 ma subito dopo da questo errore "indice non compreso nell'intervallo" alla seguente riga:
With WB.VBProject.VBComponents(SH.Name).CodeModule
non so perché
draleo

[draleo]

Ho provato con un nuovo file vergine e tutto funziona bene; ma se provo a rinominare i vari fogli con nomi diversi da Foglio1,Foglio2,Foglio3 ecc (come è nei miei files, in cui tutti i fogli hanno un nome), lo stesso errore si ripresenta. Deduco quindi che l'errore dipenda dai nomi dei fogli
draleo

[casanmaner]

Prova a sostituire con:

With WB.VBProject.VBComponents(SH.CodeName).CodeModule

[draleo]

Ok. ora va bene. Ancora grazie
draleo

[draleo]

Sicuramente sono io che ho poche conoscenze in fatto di Forms, ma forse ho cantato vittoria troppo presto. Infatti Nei casi reali ci sono dei problemi. Se sui vari fogli ci sono già altri pulsanti Active X (collegati alle rispettive macro), la macro fa un po’ di confusione con i loro nomi(name), non con le caption che infatti vengono inserite correttamente.
Essa infatti Inserisce un nuovo pulsante di nome CommandButton1;ma se questo già esisteva, da errore: rilevato nome non univoco. Ho provato ad assegnargli un nome diverso (non presente nel rispettivo foglio come per es )
Const sButtonName = "CommandButton4"
Ma in tal caso è anche peggio perché mi cambia la macro associata al pulsante commandButton1 scambiandone le funzioni
Quindi occorrerebbe che la sub tester, prima di creare il nome del commandButton, su ogni foglio rilevi i nomi di quelli già esistenti e ne assegni un altro (se per es esistessero già CommandButton1, CommandButton3, e 5, dovrebbe dargli il nome CommandButton6).
Chiedo troppo ?
draleo

[casanmaner]

ciao io non riesco a replicare i tuoi problemi.
Questo comando:

Set OleObj = SH.OLEObjects.Add( _
ClassType:="Forms.CommandButton.1", _
Link:=False, _
DisplayAsIcon:=False, _

Left:=250, _
Top:=117, _
Width:=307, _
Height:=33)

aggiunge normalmente un controllo CommandButton assegnando in automatico un nome e una caption "CommandButtonX" dove X è un numero progressivo in base a quante altri commandbutton sono presenti.
Se, ad es., nel foglio1 vi fossero presenti già tre commandbutton con nome 1,2 e 3, verrebbe aggiunto un CommandButton4 (e le successive righe di comando vanno a modificare il nome del controllo e la caption).
Il tutto senza errori di VBA.

[draleo]

Mah… è strano. Io apro un nuovo file Excel "pulito".lancio la macro per la prima volta e su tutti i fogli appare il nuovo pulsante;la lancio una seconda volta (cambiando la macro associata, la posizione, e la caption). Il secondo pulsante viene generato, ma, subito dopo mi appare il messaggio "rilevato nome non univoco" e mi mostra i moduli dei fogli dove su tutti essi trovo
Private Sub CommandButton1_Click()
prova
End Sub
Private Sub CommandButton1_Click()
prova2
End Sub
cioè Sub Commandbutton1_click è presente due volte e, secondo me, è questo che genera l'errore
draleo

[draleo]

La macro che uso è questa (leggermente modificata per fare le prove, ma non cambia niente)

Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim OleObj As OLEObject
Dim sCode As String

Const sCaption As String = "prova"
Const sButtonName = "CommandButton1"

Set WB = ActiveWorkbook
For Each SH In WB.Worksheets
With SH

Set OleObj = SH.OLEObjects.Add( _
ClassType:="Forms.CommandButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=250, _

Top:=148, _
Width:=130, _

Height:=33)
End With

With OleObj
.Name = sButtonName
With .Object
.Caption = sCaption
With .Font
.Name = " Calibri"
.Bold = True
.Size = 14
End With
End With
End With

sCode = "Private Sub " & sButtonName & "_Click()" & vbNewLine

sCode = sCode & "prova" & vbCrLf

sCode = sCode & "End Sub"

With WB.VBProject.VBComponents(SH.CodeName).CodeModule

[draleo]

Pardon. Ho finalmente capito dove sbagliavo (spero): utilizzavo come nome del pulsante CommandButton1 anche nei lanci successivi; mentre tale nome dovrebbe essere sempre cambiato ad ogni nuova esecuzione. E poiché nei miei files le caption dei pulsanti sono diverse una dall'altra,ma i nomi dei pulsanti sono sempre CommandButton1,CommandButton2,CommandButton3 ecc è chiaro che dandogli il nome Command Button1 poteva capitare che dava errore la dove questo nome già esisteva

draleo

[casanmaner]

La procedura ad ogni azionamento crea il codice evento del pulsante nei relativi fogli.
Ovviamente se nello stesso modulo hai due "macro" con lo stesso nome il VBA dà errore perché non possono aversi due "macro" con lo stesso nome in quanto il VBA non saprebbe quale delle due azionare.
La procedura lanciata più volte in automatico crea un controllo con nome differente (anche se viene visualizzato lo stesso nome nella barra della formula nelle proprietà il nome è differente).
Però questa parte di codice:

sCode = "Private Sub " & sButtonName & "_Click()" & vbNewLine

sCode = sCode & " Call CopiaFiltro_Libero" & vbCrLf

sCode = sCode & "End Sub"

With WB.VBProject.VBComponents(SH.Name).CodeModule

.insertlines .CountOfLines + 1, sCode
End With
Next SH

aggiungerà ad ogni esecuzione lo stesso codice evento in base al valore indicato nella costante sButtonName

[draleo]

OK. grazie per la pazienza. Comunque visto che un mio file, a causa dei miei errori, si è incasinato con i pulsanti, dovrò cancellare tutti pulsanti e poi reintrodurli in maniera corretta. Quindi per automatizzare avrei bisogno di altre 2 macro:
1) che mi cancelli tutti i pulsanti di tutti i fogli e le relative macro d'evento nei rispettivi fogli?
2)che mi cancelli 1 solo pulsante e la sua macro d'evento, basandosi sulla sua caption
ma non sono capace di realizzarle
draleo

[casanmaner]

Se il file è uno solo credo si faccia prima a fare le cose manualmente.
Soprattutto eliminare dal VBA le macro non necessarie senza rischiare di eliminare magari del codice invece che deve rimanere :)

[casanmaner]

Comunque, relativamente all'eliminazione di tutti i CommandButton presenti in tutti i fogli potresti provare qualcosa del genere

Sub EliminaCommandButton()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim OleObj As OLEObject

Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets
For Each OleObj In Ws.OLEObjects
Debug.Print TypeName(OleObj.Object)
If TypeName(OleObj.Object) = "CommandButton" Then
OleObj.Delete
End If
Next OleObj
Next Ws
End Sub


Nota che elimina tutti i commandbutton senza distinzione.
Se si volesse eliminare in base alla Caption occorrerebbe impostare una ulteriore condizione (es. If OleObj.Caption = "testo caption" then ...)

[draleo]

Si. va benissimo. Con questa macro e quella precedente(che aggiunge nuovi pulsanti) credo che riuscirò a portare ordine e logica nei CommandButton di una decina di file, con 15-16 fogli ciascuno. Ad ogni pulsante di ogni foglio e di ogni file lo stesso nome, la stessa caption e la stessa macro e la stessa posizione. Attualmente questi files, pur avendo tutti la stessa struttura, hanno i pulsanti talmente scompaginati , che metterci le mani è un vero problema. Se solo riuscissi anche a cancellare in un colpo solo anche tutte le macro ( che sono solo macro d'evento Private Sub CommandButtonX_Click()) poste sui moduli dei singoli fogli, sarebbe il massimo. Altrimenti pazienza… le cancellerò a mano
draleo
draleo

[Ammammata]

Il giorno Mon 02 Jul 2018 04:20:21p, *draleo* ha inviato su
microsoft.public.it.office.excel il messaggio news:bb417ee1-945a-4a7d-8c28-
53c1a4...@googlegroups.com. Vediamo cosa ha scritto:

>> > > > > > > > > > > > > > In conformità con la tua richiesta

imho 15 livelli di rientro sono troppi per seguire il thread, direi che
giunti a un certo punto o si formatta meglio il post (a manina) oppure ci
si da un taglio netto, riducendolo all'essenziale e ricominciando da un
livello umano

a meno che stiate facendo una gara per vedere chi vince a fine mese per il
maggior numero di byte postati ;) :P

--
/-\ /\/\ /\/\ /-\ /\/\ /\/\ /-\ T /-\
-=- -=- -=- -=- -=- -=- -=- -=- - -=-
>>>>> http://www.bb2002.it :) <<<<<
........... [ al lavoro ] ...........

[casanmaner]

Il giorno lunedì 2 luglio 2018 16:20:23 UTC+2, draleo ha scritto:
> Se solo riuscissi anche a cancellare in un colpo solo anche tutte le macro ( che > sono solo macro d'evento Private Sub CommandButtonX_Click()) poste sui moduli
> dei singoli fogli, sarebbe il massimo. Altrimenti pazienza… le cancellerò a mano
> draleo

Facendo molta attenzione all'uso che se ne fa (soprattutto in quali cartelle di lavoro) prova qualcosa del genere che elimina tutti i commandbutton e elimina, inserendo solo la riga "Option Explicit" come prima dichiarazione, tutto il codice VBA presente nei moduli di classe di tutti i fogli presenti nella cartella di lavoro.
Eventualmente prima fai una copia dei file di interesse ;)

Sub EliminaCommandButtonECodiceFogli()

Dim Wb As Workbook
Dim Ws As Worksheet
Dim OleObj As OLEObject

Dim oCodeModule As Object 'CodeModule

Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets
For Each OleObj In Ws.OLEObjects

If TypeName(OleObj.Object) = "CommandButton" Then
OleObj.Delete
End If
Next OleObj

Set oCodeModule = Wb.VBProject.VBComponents(Ws.CodeName).CodeModule
With oCodeModule
.DeleteLines 1, .CountOfLines
.InsertLines 1, "Option Explicit"
End With
Next Ws
End Sub

[draleo]

> Facendo molta attenzione all'uso che se ne fa (soprattutto in quali cartelle di lavoro) prova qualcosa del genere che elimina tutti i commandbutton e elimina, inserendo solo la riga "Option Explicit" come prima dichiarazione, tutto il codice VBA presente nei moduli di classe di tutti i fogli presenti nella cartella di lavoro.
> Eventualmente prima fai una copia dei file di interesse ;)
>
> Sub EliminaCommandButtonECodiceFogli()
> Dim Wb As Workbook
> Dim Ws As Worksheet
> Dim OleObj As OLEObject
> Dim oCodeModule As Object 'CodeModule
> Set Wb = ActiveWorkbook
> For Each Ws In Wb.Worksheets
> For Each OleObj In Ws.OLEObjects
> If TypeName(OleObj.Object) = "CommandButton" Then
> OleObj.Delete
> End If
> Next OleObj
> Set oCodeModule = Wb.VBProject.VBComponents(Ws.CodeName).CodeModule
> With oCodeModule
> .DeleteLines 1, .CountOfLines
> .InsertLines 1, "Option Explicit"
> End With
> Next Ws
> End Sub

Ottimo, rapido,nessun inconveniente, utilissimo. Complimenti. In un oretta (tra l'altro mentre guardavo la partita) ho sistemato una decina di files, risparmiando ore di lavoro. Precauzionalmente , prima delle modifiche,avevo fatto tutte le copie; ma non credo che serviranno, perché tutto mi sembra funzionare al meglio
draleo

[draleo]

Si. scusate.hai ragione. ma il mio Pc mi nasconde le quote (per vederle devo cliccare su "mostra testo citato" e non sempre mi ricordo di farlo)e non mi accorgo di quanto siano prolisse. Vedrò di ricordarlo
grazie
draleo