Questo browser non è più supportato.
Esegui l'aggiornamento a Microsoft Edge per sfruttare i vantaggi di funzionalità più recenti, aggiornamenti della sicurezza e supporto tecnico.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Buon Giorno a tutti
sono nuovamente a chiedere aiuto ....
utilizzo un codice VB creato dal Grande Norman Jones ...che nuovamente ringrazio , ...per copiare un singolo Foglio di excel da una cartella , in un altro Unico ,senza riportare ;Formule e collegamenti .................. Funziona perfettamente !!! pero' Copia Anche il Pulsante che fa' partire l'evento ...con il suo collegamento alla Macro , .... per cui una volta salvato il nuovo Foglio , bisogna Tagliare il Pulsante per interrompere i collegamenti ......
Esiste un modo per evitare questo evento ???
Una soluzione palliativa l'ho gia' individuata , Posizionare il Pulsante in Altro Foglio della Cartella di lavoro ...sostituendo nel codice
With Activesheet ..... il nome del Foglio interessato .... pero' questo rende complicate le operazioni .. i fogli dove dovrei inserire i pulsanti sono 14 ... e vorrei evitare di dover passare continuamente da un foglio all'altro e inserire 14 macro (una per ogni pulsante ...)
il codice e' il seguente
Dim VBC As Object
Dim p As String
Sub CopiaFoglio()
' Seleziona la cartella destinazione in DDir
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = DDir '<<< Filtro per nome
.Title = "Scegli la directory per il foglio " & ActiveSheet.Name
.Show
If .SelectedItems.Count = 0 Then 'directory non scelta
MsgBox ("Scelta non effettuata, procedura abortita")
Exit Sub
End If
DDir = .SelectedItems(1) & ""
End With
'Copia il foglio in un'altro al volo
'Converte tutte le formule del foglio nel
'valore al momento calcolato
ActiveSheet.Copy
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
' Salva il foglio
NewFName = DDir & FPrefix & ActiveSheet.Name & ".xlsx"
ActiveWorkbook.SaveAs Filename:=NewFName
ActiveWorkbook.Close
With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
End If
Next VBC
End With
End Sub
Grazie Claudio P
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.
Ciao Claudio, Ciao Mauro,
**ActiveSheet.**Shapes.Range(Array("CommandButton1")).Select
Selection.Delete
Senza la selezione e più brevemente, forse:
ActiveSheet.Shapes("CommandButton1").Delete
oppure
ActiveSheet.OLEObjects("CommandButton1").Delete
===
Regards,
Norman
**ActiveSheet.**Shapes.Range(Array("CommandButton1")).Select
Selection.Delete
Dove le parti in grassetto vanno modificate con il nome del tuo foglio e del tuo CommandButton.
Grazie Norman
Rifaccio le Prove mettendo le istruzioni subito prima di End Sub ....per vedere se era quello il mio sbaglio ..
Poi Sostituiro' il codice con il tuo ultimo ... Prefix ....??? per me' e' un termine nuovo ...suppongo che sia il Nome Fisso da dare al nuovo Foglio .... io metto "Pippo" ....vedo cosa succede e poi sostituisco con piu' congruo ..
GRAZIE GRAZIE con questa ultima parte il Progetto Pratiche e' Finito grazie a te e alla community
Claudio P
Ciao Claudio,
Ciao Norman e anche Mauro
...... AAArrrrgh .....provate tutte e 3 .....non capisco ....
Ho Provato
Sheet("Pippo").Shapes.Range(Array("CommandButton3")).Select
Selection.Delete mi da' errore
**ActiveSheet.**Shapes.Range(Array("CommandButton3")).Select
Selection.Delete
mi da' errore
ActiveSheet.Shapes("CommandButton3").Delete .... mi da' errore
Sheet("Pippo").Shapes("CommandButton3").Delete .... mi da' errore
ActiveSheet.OLEObjects("CommandButton3").Delete (Oggetto mancante )
io ho aggiunto queste righe ; prima della sezione Copia e poi anche ..alla fine della sezione copia (non insieme ..)
Se metto il nome del foglio mi dice oggetto mancante , ma anche se lascio ActiveSheet ......
C'aggio a FA' ? ....
A me, e a patto che la nuova istruzione sia immessa nel punto giusto del codice, qualunque dei suggerimenti offerti da Mauro e io andrebbero benissimo.
Nelle mie prove, ho inserito la nuova istruzione come l'ultima riga della macro, immediatamsnte prima di
End Sub.
Detto questo, vedo altri problemi con tuo codice e per migliorarlo, suggerirei la seguente versione leggermente modificata del tuo codice:
'=========>>
Option Explicit
'--------->>
Public Sub CopiaFoglio()
Dim WB As Workbook
Dim DDir As String, NewFname As String
Dim VBC As Object
Const FPrefix = "PrefissoSceltoDaClaudio" '<<=== Modifica
Set WB = ThisWorkbook
'\ Seleziona la cartella destinazione in DDir
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = DDir '\ Filtro per nome
.Title = "Scegli la directory per il foglio " & ActiveSheet.Name
.Show
If .SelectedItems.Count = 0 Then '\directory non scelta
MsgBox ("Scelta non effettuata, procedura abortita")
Exit Sub
End If
DDir = .SelectedItems(1) & ""
End With
'\ Copia il foglio in un'altro al volo
'\ Converte tutte le formule del foglio nel
'\ valore al momento calcolato
With ActiveSheet
.Copy
With .UsedRange
.Value = .Value
End With
End With
'\ Salva il foglio
NewFname = DDir & FPrefix & ActiveSheet.Name & ".xlsx"
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs Filename:=NewFname, FileFormat:=51
.Close
End With
With WB.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
End If
Next VBC
End With
ActiveSheet.OLEObjects("CommandButton1").Delete
XIT:
Application.DisplayAlerts = True
End Sub
'<<=========
===
Regards,
Norman
Ciao Norman e anche Mauro
...... AAArrrrgh .....provate tutte e 3 .....non capisco ....
Ho Provato
Sheet("Pippo").Shapes.Range(Array("CommandButton3")).Select
Selection.Delete mi da' errore
**ActiveSheet.**Shapes.Range(Array("CommandButton3")).Select
Selection.Delete
mi da' errore
ActiveSheet.Shapes("CommandButton3").Delete .... mi da' errore
Sheet("Pippo").Shapes("CommandButton3").Delete .... mi da' errore
ActiveSheet.OLEObjects("CommandButton3").Delete (Oggetto mancante )
io ho aggiunto queste righe ; prima della sezione Copia e poi anche ..alla fine della sezione copia (non insieme ..)
Se metto il nome del foglio mi dice oggetto mancante , ma anche se lascio ActiveSheet ......
C'aggio a FA' ? ....
Claudio P