VB Copia Foglio Excel senza Formule .... senza Copiare Pulsante Macro

Anonimo

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

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.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

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

![](http://fud.community.services.support.microsoft.com/Fud/FileDownloadHandler.ashx?fid=f5cf0fd8-e2e7-47d5-86b2-27f0848297f8)

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

**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.

0 commenti

33 risposte aggiuntive

Anonimo

2016-06-28T05:36:41+00:00

Buon Giorno Norman

.......................................... BREXIT ...............................................................................

Inconsistenti le notizie della crisi del mercato della produzione della Birra .....

Gli Italiani riprendono a consumare massicce quantita' del liquido Luppolato ,Bionde,Rosse,Scure .................

Sorry Claudio P
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2016-06-21T18:33:54+00:00

Ciao Norman

OK ....niente magia nera ....niente sale ....FUNZIONA PERFETTAMENTE il pulsante rimane nel Foglio origine ......

...pero' ..... lo dico solo perche' quando ho fatto la prova con il mio file ....nel foglio origine ha CANCELLATO tutte le formule esistenti ... e le ha copiate nel foglio destinazione ...... ho risolto sostituendo

With ActiveSheet

.Copy

With .UsedRange

.Value = .Value

End With

End With

Con

With Activesheet

        .Copy

    Cells.Select

    Selection.Copy

    Cells.Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    Range("A1").Select

    End With

Cosi le formule del Foglio Origine restano al loro posto e nel Foglio Destinazione vengono copiati testo e valori

Ti ringrazio TANTISSSIMO per tutto il tempo che mi hai dedicato , ti auguro una buona settimana ........ Credo che non corro nessun rischio di rinunciare a bere birra per un mese ..... ma giuro se l'Inghilterra vince gli Europei rimango astemio per un mese !!!!!!!

Ciao e GRAZIE Claudio P
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2016-06-21T15:05:20+00:00

Ciao Claudio,

fatto prova .....nuovo foglio non ha ne pulsanti ne formule ....foglio origine ha il Pulsante .... Funziona ......??

Devo provare il codice con il mio file ????

sotto screenshot

[Cut]

Visto lo screenshot che non ho tolto, mi pare che vada bene, anche se non credo che la modifica del mio codice per esplicitamente cancellare eventuali pulsanti avrebbe dovuto essere necessario. Tuttavia, mi pare che non tutto vada bene in questa vita - per assoluta conferma di questa ipotesi basta considerare il risultato ieri sera! (;-

Ad ogni modo, ho modificato il codice, qui sotto e nel file su DropBox, per commentare i tre MsgBox, e ti chiederei di provalo con il tuo file. Se, anche così, tutto vada bene avrai risparmiato il sale e l'aglio e potresti chiudere il thread definitivamente.

'=========>>

Option Explicit

'--------->>

Public Sub CopiaFoglio()

Dim WB As Workbook

Dim DDir As String, NewFname As String

Dim iButtons As Long

Const FPrefix = "Pippo - " '<<=== 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

With .Sheets(1)

iButtons = .Buttons.Count

Call MsgBox( _

Prompt:=iButtons & " pulsanti trovati sul foglio " _

& .Name & " del file " & .Parent.Name, _

Buttons:=vbInformation, _

Title:="REPORT #1")

If CBool(iButtons) Then

.Buttons.Delete

' Call MsgBox( _

' Prompt:=iButtons & " pulsanti trovati sul foglio " _

' & .Name & " del file " & .Parent.Name, _

' Buttons:=vbInformation, _

' Title:="REPORT #2")

End If

.SaveAs Filename:=NewFname, FileFormat:=51

' Call MsgBox(Prompt:="Il foglio " & .Name _

' & " del file" _

' & NewFname _

' & vbNewLine _

' & "comprende:" _

' & vbNewLine & vbNewLine _

' & ActiveSheet.Shapes.Count & vbTab & " Oggetti Shape; " _

' & vbNewLine _

' & .Buttons.Count & vbTab & "Pulsante Modulo" _

' & vbNewLine _

' & .OLEObjects.Count & vbTab & "Controlli ActiveX", _

' Buttons:=vbInformation, _

' Title:="DETECT PHANTOM BUTTON")

End With

.Close

End With

With ActiveSheet

' Call MsgBox(Prompt:="Il foglio " & .Name _

' & " del file" _

' & ActiveWorkbook.Name _

' & vbNewLine _

' & "comprende:" _

' & vbNewLine & vbNewLine _

' & ActiveSheet.Shapes.Count & vbTab & " Oggetti Shape; " _

' & vbNewLine _

' & .Buttons.Count & vbTab & "Pulsante Modulo" _

' & vbNewLine _

' & .OLEObjects.Count & vbTab & "Controlli ActiveX", _

' Buttons:=vbInformation, _

' Title:="CONFERMA PRESENZA DEL BOTTONE")

End With

XIT:

Application.DisplayAlerts = True

End Sub

'<<=========

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento