macro per salvare foglio

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

salva_1Ciao a tutti.
Il workbook allegato salva una copia in pdf in una cartella dove è inserito che crea in automatico.
Funziona bene ma se in B1 scrivo solo numeri non funziona.

Scrivi un numero con lettere in B1
clicca salva
compare msgbox rinomina il foglio
clicca rinomina
clicca salva
poi clicca 2 volte Si nei msgbox
e si salva una copia del foglio in una cartella dove il workbook è inserito

Se però in B1 scrivo solo numeri non funziona.

Forse il problema è in questo msgbox in modulo1

rese = ActiveSheet.Name If ActiveSheet.Range("B1").Value <> rese Then avviso = MsgBox("Non hai rinominato il nome del foglio come commessa!", _ vbQuestion + vbOKOnly + vbCritical, "AVVISO!") If avviso = 7 Then Exit Sub End If

Nella macro in modulo1 io ho aggiunto questo msgbox

'----------------------------------------------------------------------------------------------- rese = ActiveSheet.Name If ActiveSheet.Range("B1").Value <> rese Then avviso = MsgBox("Non hai rinominato il nome del foglio come commessa!", _ vbQuestion + vbOKOnly + vbCritical, "AVVISO!") If avviso = 7 Then Exit Sub End If If ActiveSheet.Range("B1") <> "" And ActiveSheet.Name = ActiveSheet.Range("B1") Then '------------------------------------------------------------------------------------------------

prima senza questo msgbox funzionava bene

un aiuto?
Grazie

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Per errore ho eliminato l'allegato in risposta #53999 che riallego qui

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Ciao @frank_ciccio

1) già altre volte ti ho spiegato che per pubblicare il codice devi utilizzare il TagCode. Vedi dove c'è scritto sulla Dashboard posta in alto (codice VBA)? Ecco devi premere quel pulsante e scrivere in quel editor il tuo codice. mi auguro di non doverlo più ricordare. Adesso il codice che hai pubblicato lo sistemo io.

2) Tornando al tuo problema...la tua macro purtroppo è piena di errori, ad esempio qui:

Dim NomeFoglio, CurFolder, DestFolder, Destfile As String

NomeFoglio, CurFolder eDestFolder le stai dichiarando come Variant e non come String (come dovrebbe essere) e già questo è un errore. Potrai avere dei problemi se non le dichiari correttamente.

Poi le MsgBox restituiscono un valore numerico e non di tipo stringa. Quindi non devi scrivere:

avviso = MsgBox("manca il nome della commessa in B1!", _
vbQuestion + vbOKOnly + vbCritical, "AVVISO!")
If avviso = 7 Then Exit Sub

la variabile avviso l'hai dichiarata come String ma dovrebbe essere Byte, Integer o Long

Ancora...hai utilizzato alcune variabili Stringa simili tra loro:

Dim name1 As String, name2 As String, name3 As String, name4 As String, name5 As String, name6 As String, name7 As String

qui name bisognerebbe evitarla visto che è una parola riservata (Keyword). Esempio: ActiveSheet.Name). Ora tu le hai differenziate come:

Dim name1 As String, name2 As String, name3 As String, ....name7 As String e può anche andar bene ma ha più senso scrivere nome1 As String, nome2 As String, nome3 As String, ...., nome7 As String

Anzi meglio ancora:

Dim nome(1 To 7) As String

nome(1) = "prova1"
nome(2) = "prova2"
nome(3) = "prova3"
....
....

Ad ogni modo il problema che lamenti è dato dal fatto che nel caso di numeri in cella, tu stai valutando una comparazione tra una Stringa e un Numero:

If ActiveSheet.Range("B1") <> "" And ActiveSheet.Name = ActiveSheet.Range("B1") Then

ActiveSheet.Name = stringa

ActiveSheet.Range("B1") = numero se scrivi ad esempio 14

Potresti risolvere scrivendo:

If ActiveSheet.Range("B1") <> "" And ActiveSheet.Name = CStr(ActiveSheet.Range("B1")) Then

ma mi sento di consigliarti di rivedere tutta la struttura della macro. Ad esempio tu inizi rimuovendo la protezione al Foglio, poi chiedi, attraverso MsgBox, all'utente se ha fatto o meno delle cose. Se l'utente sceglie NO, la macro si interrompe ma il foglio rimane senza protezione e per di più con l'aggiornamento dello schermo disabilitato.

Ma non solo questo, la tua macro si può riscriverla in maniera molto più strutturata e corta. Se vuoi ti do una mano a riscriverla ma devo capire a cosa serve questa parte:

Sheets(NomeFoglio).Select
Sheets(NomeFoglio).Copy
      
 '---------------------------------------------------------------------------------------
 
Sheets(NomeFoglio).Protect "123456"
 
       
ActiveWindow.Close 'se non attivo mostra il nuovo file

visto che copia il foglio, gli applica la protezione e basta...quindi? Che deve fare poi?

Oppure se puoi spiega meglio tutta la procedura che avevi in mente di ottenere.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao alexps81 la tua modifica funziona

If ActiveSheet.Range("B1") <> "" And ActiveSheet.Name = CStr(ActiveSheet.Range("B1")) Then

per  il resto la macro è un misto di altre macro che non so creare e che cerco di far funzionare.

Questa parte di macro

`Sheets(NomeFoglio).Select
Sheets(NomeFoglio).Copy
      
 '---------------------------------------------------------------------------------------
 
Sheets(NomeFoglio).Protect "123456"
 
       
ActiveWindow.Close 'se non attivo mostra il nuovo file`

 serve per proteggere il nuovo foglio creato e non mostrarlo.

Se ti va creare una macro più semplice, prova pure.

Ancora grazie

[alexps81Moderatore alexps81 Karma: 58 pts]

@franck_ciccio quello che non mi è chiaro è perché dopo che crei il file PDF, crei anche una copia del Foglio Attivo in una nuova istanza, gli applichi la protezione e poi chiudi la cartella di lavoro appena creata senza salvarla. Di fatto tu, ad un certo punto, nel codice scrivi:

With Application
 .DisplayAlerts = False
End With

cioè disabiliti gli avvisi, per poi alla fine abilitarli nuovamente con:

With Application
 .DisplayAlerts = True
End With

In questo modo quando fai: ActiveWindow.Close a causa della disabilitazione degli avvisi, ti verrà chiusa la cartella di lavoro appena creata senza avvisarti se salvarla oppure no.

Perché devi creare una copia del Foglio Attivo? Se c'è un motivo, perché non va salvata?

Poi altra cosa: nelle varie variabili che hai definito con name1, name2, name3, ecc...perché non viene mai utilizzata name2?

Non limitarti a pensare che adesso funziona con il suggerimento che ti ho dato prima...questa macro va sistemata. Io una bozza ce l'ho già ma prima di pubblicarla serve che tu dia risposte chiare ai miei dubbi in modo da darti qualcosa di funzionante.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Purtroppo la macro che crea il pdf che ho allegato  è un misto di macro.

Alla fine la macro  deve creare una cartella con sottocartelle in automatico con il nome che è nel range M

in queste cartelle deve salvarsi la copia pdf del foglio attivo.

[alexps81Moderatore alexps81 Karma: 58 pts]

@frank_ciccio vedi se riscritta così va bene, ma soprattutto se sei in grado di apportare eventuali modifiche:

Option Explicit

Sub SALVA_GRAFICO_PDF_2() 'o.k.
    Dim NomeFoglio As String
    Dim DestFolder As String, Destfile As String
    Dim sData As String
    Dim commessa As String
    Dim nome(1 To 7) As String
    
    NomeFoglio = ActiveSheet.Name
    
    commessa = Range("B1").Value
    If Trim(commessa) = "" Then
        MsgBox "non hai inserito il nome della commessa in B1", vbExclamation, "Avviso!"
        Range("B1").Select
        Exit Sub
    End If
    
    If StrComp(NomeFoglio, commessa, vbBinaryCompare) <> 0 Then
        MsgBox "Non hai rinominato il nome del foglio come commessa!", vbExclamation, "Avviso!"
        Exit Sub
    End If
    
    '=== capire meglio l'ordine delle variabili e il loro contenuto!!! ===
    nome(6) = "prova"
    nome(1) = "prova " & nome(6) & " prova"
    nome(3) = Range("M3").Value
    nome(4) = Range("M4").Value
    nome(5) = Range("M5").Value
    nome(7) = Range("M2").Value
    '=====================================================================
             
    If MsgBox("salvo le modifiche al grafico < " & commessa & " > in formato *.pdf?" & String(2, vbCrLf) & _
             "ricorda che prima di salvare il foglio < " & nome(1) & " > in formato *.pdf, di regolare le interruzioni di pagina / colore foglio ecc.." _
             & String(2, vbCrLf) & "Fatto?", vbQuestion + vbYesNo + vbDefaultButton2, "AVVISO!") = vbNo Then Exit Sub
             
    
    On Error GoTo uscitaPulita
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "123456"
    
    NomeFoglio = Join(Array(ActiveSheet.Name, nome(3), nome(4), nome(5)), " - ")
   
    sData = Format(Date, "dd.mm.yyyy") 'data del file salvato
   
    DestFolder = ActiveWorkbook.Path & "\" & nome(1) & "\" & nome(7) & "\" '1a/2a cartella
    Call creaPercorsoCompleto(DestFolder)
     
    Destfile = DestFolder & NomeFoglio & ".pdf" '<<< no num. progress.
         
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=Destfile, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False '<<< non si apre il pdf
    
    MsgBox "Fatto", vbInformation, vbNullString
    
uscitaPulita:
    ActiveSheet.Protect "123456"
    Application.ScreenUpdating = True
    Exit Sub

errore:
    MsgBox "Errore: " & Err.Description, vbCritical, "Errore"
    Resume uscitaPulita
End Sub

Sub creaPercorsoCompleto(pathCompleto As String)
    Dim parte As Variant
    Dim percorso As String
    
    For Each parte In Split(pathCompleto, "\")
        If parte <> "" Then
            If percorso = "" Then
                percorso = parte
            Else
                percorso = percorso & "\" & parte
            End If
            
            If InStr(percorso, ":") = 0 Then GoTo NextParte
            If Dir(percorso, vbDirectory) = "" Then MkDir percorso
        End If
NextParte:
    Next parte
End Sub

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie alexps81.

La macro ora è molto più ridotta.

Ora vedo come adattarla ad altri fogli /lavori che hanno una macro per salvare nella stessa cartella.

Grazie ancora

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ho cambiato dei riferimenti alle celle e ho aggiunto il numero progressivo al file salvato copiando dalla mia macro

Do '<<< per numero progressivo
  nSfx = nSfx + 1 '<<< per numero progressivo
     
     
    'Destfile = DestFolder & NomeFoglio & ".pdf" '<<<
    'Destfile = DestFolder & NomeFoglio & " - " & sData & ".pdf" '<<< con data
    Destfile = DestFolder & NomeFoglio & " - " & sData & " - " & nSfx & ".pdf" '<<< con data e con numero progressivo
         
         
    Loop While Dir(Destfile) <> vbNullString '<<< per numero progressivo

se ho fatto giusto .

E' possibile cambiare l'estensione del file di salvataggio da pdf a xlsx?

Deve salvare senza macro

 

Option Explicit




Sub SALVA_GRAFICO_PDF_2_NEW() 'ALEXPS81 o.k.
    Dim NomeFoglio As String
    Dim DestFolder As String, Destfile As String
    Dim sData As String
    Dim commessa As String
    Dim nome(1 To 7) As String
    Dim nSfx As Long
    
    
    NomeFoglio = ActiveSheet.Name
    
    commessa = Range("B1").Value
    If Trim(commessa) = "" Then
        MsgBox "non hai inserito il nome della commessa in B1", vbExclamation, "Avviso!"
        Range("B1").Select
        Exit Sub
    End If
    
    If StrComp(NomeFoglio, commessa, vbBinaryCompare) <> 0 Then
        MsgBox "Non hai rinominato il nome del foglio come commessa!", vbExclamation, "Avviso!"
        Exit Sub
    End If
    
    '=====================================================================
    '=== capire meglio l'ordine delle variabili e il loro contenuto!!! ===
    nome(6) = Range("B2").Value
    nome(1) = "grafici " & nome(6) & " salvati"
    nome(3) = Range("D1").Value
    nome(4) = Range("G1").Value
    nome(5) = Range("J1").Value
    nome(7) = Range("B1").Value
    '=====================================================================
             
    If MsgBox("salvo le modifiche al grafico < " & commessa & " > in formato *.pdf?" & String(2, vbCrLf) & _
             "ricorda che prima di salvare il foglio < " & nome(1) & " > in formato *.pdf, di regolare le interruzioni di pagina / colore foglio ecc.." _
             & String(2, vbCrLf) & "Fatto?", vbQuestion + vbYesNo + vbDefaultButton2, "AVVISO!") = vbNo Then Exit Sub
             
    
    On Error GoTo uscitaPulita
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect "123456"
    
    NomeFoglio = Join(Array(ActiveSheet.Name, nome(3), nome(4), nome(5)), " - ")
   
    sData = Format(Date, "dd.mm.yyyy") 'data del file salvato
   
    DestFolder = ActiveWorkbook.Path & "\" & nome(1) & "\" & nome(7) & "\" '1a/2a cartella
    Call creaPercorsoCompleto(DestFolder)
     
     
     Do '<<< per numero progressivo
     nSfx = nSfx + 1 '<<< per numero progressivo
     
     
    'Destfile = DestFolder & NomeFoglio & ".pdf" '<<<
    'Destfile = DestFolder & NomeFoglio & " - " & sData & ".pdf" '<<< con data
    Destfile = DestFolder & NomeFoglio & " - " & sData & " - " & nSfx & ".pdf" '<<< con data e con numero progressivo
         
         
    Loop While Dir(Destfile) <> vbNullString '<<< per numero progressivo
      
         
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=Destfile, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False '<<< true si apre il pdf
    
    MsgBox "Fatto", vbInformation, vbNullString
    
uscitaPulita:
    ActiveSheet.Protect "123456"
    Application.ScreenUpdating = True
    Exit Sub

errore:
    MsgBox "Errore: " & Err.Description, vbCritical, "Errore"
    Resume uscitaPulita
End Sub

 

 

[alexps81Moderatore alexps81 Karma: 58 pts]

frank_ciccio ha scritto:

E' possibile cambiare l'estensione del file di salvataggio da pdf a xlsx?

Deve salvare senza macro

Ma quindi devi salvare il foglio in PDF oppure creare una copia del foglio e salvare la cartella di lavoro in xlsx?

All'inizio avevo capito che dovessi salvarlo in PDF.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao,

va bene salvare in pdf.

Per salvare in xlsx è solo per provare a modificare la tua macro.

[alexps81Moderatore alexps81 Karma: 58 pts]

@franck_ciccio vedi se ho capito bene ciò che ti serve. Adesso crea il PDF e contestualmente salva una copia del foglio in formato XLSX nella stessa cartella del PDF

Option Explicit

Sub SALVA_GRAFICO_PDF_2_NEW() 'ALEXPS81 o.k.
    Dim NomeFoglio As String
    Dim DestFolder As String, Destfile As String
    Dim sData As String
    Dim commessa As String
    Dim nome(1 To 7) As String
    Dim nSfx As Long
    Dim wsOrigine As Worksheet, wsCopiato As Worksheet
    
    Set wsOrigine = ThisWorkbook.ActiveSheet
    
    NomeFoglio = wsOrigine.Name
    
    commessa = wsOrigine.Range("B1").Value
    If Trim(commessa) = "" Then
        MsgBox "non hai inserito il nome della commessa in B1", vbExclamation, "Avviso!"
        wsOrigine.Range("B1").Select
        Exit Sub
    End If
    
    If StrComp(NomeFoglio, commessa, vbBinaryCompare) <> 0 Then
        MsgBox "Non hai rinominato il nome del foglio come commessa!", vbExclamation, "Avviso!"
        Exit Sub
    End If
    
    '=== capire meglio l'ordine delle variabili e il loro contenuto!!! ===
    nome(6) = wsOrigine.Range("B2").Value
    nome(1) = "grafici " & nome(6) & " salvati"
    nome(3) = wsOrigine.Range("D1").Value
    nome(4) = wsOrigine.Range("G1").Value
    nome(5) = wsOrigine.Range("J1").Value
    nome(7) = wsOrigine.Range("B1").Value
    '=====================================================================
             
    If MsgBox("salvo le modifiche al grafico < " & commessa & " > in formato *.pdf?" & String(2, vbCrLf) & _
             "ricorda che prima di salvare il foglio < " & nome(1) & " > in formato *.pdf, di regolare le interruzioni di pagina / colore foglio ecc.." _
             & String(2, vbCrLf) & "Fatto?", vbQuestion + vbYesNo + vbDefaultButton2, "AVVISO!") = vbNo Then Exit Sub
    
    On Error GoTo uscitaPulita
    Application.ScreenUpdating = False
    wsOrigine.Unprotect "123456"
    
    NomeFoglio = Join(Array(wsOrigine.Name, nome(3), nome(4), nome(5)), " - ")
   
    sData = Format(Date, "dd.mm.yyyy") 'data del file salvato
   
    DestFolder = ActiveWorkbook.Path & "\" & nome(1) & "\" & nome(7) & "\" '1a/2a cartella
    creaPercorsoCompleto DestFolder
     
     Do '<<< per numero progressivo
        nSfx = nSfx + 1 '<<< per numero progressivo
        Destfile = DestFolder & NomeFoglio & " - " & sData & " - " & nSfx '<<< con data e con numero progressivo
    Loop While Dir(Destfile & ".pdf") <> vbNullString '<<< per numero progressivo
      
    wsOrigine.ExportAsFixedFormat Type:=xlTypePDF, _
                                  Filename:=Destfile & ".pdf", _
                                  Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False '<<< true si apre il pdf
    
    wsOrigine.Copy '<--creo una copia del foglio attivo
    
    Set wsCopiato = ActiveSheet
    wsCopiato.Name = NomeFoglio '<--assegno il nome al nuovo foglio
    wsCopiato.Protect "123456" '<--applico la protezione con password
    
    ActiveWorkbook.SaveAs Filename:=Destfile & ".xlsx", FileFormat:=xlOpenXMLWorkbook '<--salvo la nuova Cartella di lavoro con nome
    ActiveWorkbook.Close SaveChanges:=False '<--chiudo la Cartella di lavoro appena creata
    
    MsgBox "Fatto", vbInformation, vbNullString
    
uscitaPulita:
    wsOrigine.Protect "123456"
    Application.ScreenUpdating = True
    Set wsOrigine = Nothing
    Set wsCopiato = Nothing
    Exit Sub

errore:
    MsgBox "Errore: " & Err.Description, vbCritical, "Errore"
    Resume uscitaPulita
End Sub

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie alexps81 è perfetto.

E' possibile dividere la nuova macro perchè salvi solo in xlsx come la tua prima macro in pdf?

Grazie ancora.

[alexps81Moderatore alexps81 Karma: 58 pts]

Per salvare sono in XLSX basta modificare questa parte:

Loop While Dir(Destfile & ".pdf") <> vbNullString '<<< per numero progressivo

con questa

Loop While Dir(Destfile & ".xlsx") <> vbNullString '<<< per numero progressivo

e rimuovere tutta questa:

wsOrigine.ExportAsFixedFormat Type:=xlTypePDF, _
                                  Filename:=Destfile & ".pdf", _
                                  Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, _
                                  OpenAfterPublish:=False '<<< true si apre il pdf

dovrebbe essere così...ora sto rispondendo dal cellulare e non posso provare.

[Autore]

Articoli