Salvataggio file excel e chiusura file

Stai vedendo 2 articoli - dal 1 a 2 (di 2 totali)

Autore

Articoli

16/03/2024 alle 11:13 #44593 Score: 0 | Risposta

FROST220684

Partecipante

Ciao a tutti,

Ho un file che attraverso macro crea dei file xls, xlsm e pdf. Alla creazione dei file xls/xlsm crea i file, li salva e li chiude e fin qui tutto bene fino a quando ho lasciato 2 macro separate per 2 fogli. Adesso avevo pensato di unire il codice tramite un If.

Tutto va bene nel senso che la macro va a buon fine solo che mi da debug nella parte in cui deve salvare il file xls e lo deve chiudere, insomma mi crea il file ma lo lascia aperto quindi mi ritrovo con il file originale ed il file creato aperti.

il codice che ho modificato è questo:

Sub Salva_e_Stampa()
Dim p As String
Dim s As String
Dim v As Variant
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook

    'inizio istruzioni cursore mouse
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks.Add     'in wb2 imposto riferimento a nuovo foglio di lavoro
    
    p = "Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO" 'inserire percorso cartelle preventivi
   
    
    'variabile per salvataggio con nome
'    s = "@A - @B - @C - @D - @E"
'    For i = 1 To 5
'        'v = Choose(i, "B3", "B1", "B6", "B7")
'        v = Choose(i, Trim(sCliente), x, "B1", "B6", "B7")
'        s = Replace(s, "@" & Chr$(64 + i), wb1.Worksheets("Input").Range(v))
'    Next

    With wb1.Worksheets("Input")
        If x = "" Then
            s = .Range("B3") & " - " & Trim(sCliente) & " - " & .Range("B6") & " - " & .Range("B7")
        Else
            s = .Range("B3") & " - " & Trim(sCliente) & " " & x & " - " & .Range("B6") & " - " & .Range("B7")
        End If
    End With
    
    ' inserire il nome della cartella preventivi excel al posto di Preventivi Excel
    wb1.Worksheets.Copy before:=wb2.Worksheets(1)
    
    'in cella N46 del foglio originale salvo data e ora di creazione del foglio copiato
    With wb2
        If x = "" Then
            .Worksheets("Input").Range("B1") = Trim(sCliente)
        Else
            .Worksheets("Input").Range("B1") = Trim(sCliente) & " " & x
        End If
        .Worksheets("Input").Range("B2") = sComitiva
        .Worksheets("Input").Range("N46") = "Preventivo creato il " & Date
        .SaveAs p & "\EXCEL\" & Replace(s, "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
        For Each v In .LinkSources(Type:=xlLinkTypeExcelLinks)
            .BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
        Next
        
    wb1.SaveCopyAs p & "\VBA\" & Replace(s, "/", "-") & ".xlsm"
        With Worksheets("Input")
        If .Range("E7") > 3 Then
        
        With wb2.Worksheets("Output")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\PDF\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
          
    End With
      .Worksheets("Input").Select
        .Close True  'salva e chiude il nuovo foglio creato
    End If
    If .Range("e7") < 3 Then
    With wb2.Worksheets("Output Weekend")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\PDF\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
            
    End With
    .Worksheets("Input").Select
        .Close True  'salva e chiude il nuovo foglio creato
    End If
        
    
    'fine istruzioni cursore mouse
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
ResettaFoglioparziale
Set wb1 = Nothing: Set wb2 = Nothing
End With
End With
End Sub

e mi va in debug in questa parte:

 .Worksheets("Input").Select
        .Close True  'salva e chiude il nuovo foglio creato

Ho provato a modificarlo in tutti i modi ma non riesco a farlo chiudere, spero possiate aiutarmi. Grazie mille

16/03/2024 alle 12:08 #44594 Score: 0 | Risposta

FROST220684

Partecipante

Apro e chiudo il post da solo, dopo un milione di prove ci sono arrivato da solo:

Sub Salva_e_Stampa()
Dim p As String
Dim s As String
Dim v As Variant
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook

    'inizio istruzioni cursore mouse
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks.Add     'in wb2 imposto riferimento a nuovo foglio di lavoro
    
    p = "Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO" 'inserire percorso cartelle preventivi
   
    
    'variabile per salvataggio con nome
'    s = "@A - @B - @C - @D - @E"
'    For i = 1 To 5
'        'v = Choose(i, "B3", "B1", "B6", "B7")
'        v = Choose(i, Trim(sCliente), x, "B1", "B6", "B7")
'        s = Replace(s, "@" & Chr$(64 + i), wb1.Worksheets("Input").Range(v))
'    Next

    With wb1.Worksheets("Input")
        If x = "" Then
            s = .Range("B3") & " - " & Trim(sCliente) & " - " & .Range("B6") & " - " & .Range("B7")
        Else
            s = .Range("B3") & " - " & Trim(sCliente) & " " & x & " - " & .Range("B6") & " - " & .Range("B7")
        End If
    End With
    
    ' inserire il nome della cartella preventivi excel al posto di Preventivi Excel
    wb1.Worksheets.Copy before:=wb2.Worksheets(1)
    
    'in cella N46 del foglio originale salvo data e ora di creazione del foglio copiato
    With wb2
        If x = "" Then
            .Worksheets("Input").Range("B1") = Trim(sCliente)
        Else
            .Worksheets("Input").Range("B1") = Trim(sCliente) & " " & x
        End If
        .Worksheets("Input").Range("B2") = sComitiva
        .Worksheets("Input").Range("N46") = "Preventivo creato il " & Date
        .SaveAs p & "\EXCEL\" & Replace(s, "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
        For Each v In .LinkSources(Type:=xlLinkTypeExcelLinks)
            .BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
        Next
         
    wb1.SaveCopyAs p & "\VBA\" & Replace(s, "/", "-") & ".xlsm"
        With Worksheets("Input")
        If .Range("E7") > 3 Then
        
        With wb2.Worksheets("Output")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\PDF\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
          
    End With
wb2.Worksheets("Input").Select
        wb2.Close True  'salva e chiude il nuovo foglio creato

With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
    Else
 
   
    If .Range("e7") < 3 Then
    With wb2.Worksheets("Output Weekend")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\PDF\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
            
    End With
     wb2.Worksheets("Input").Select
        wb2.Close True  'salva e chiude il nuovo foglio creato

    End If
    
    
   
    'fine istruzioni cursore mouse
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
ResettaFoglioparziale
Set wb1 = Nothing: Set wb2 = Nothing

End If
End With
End With
End Sub

So che mi avreste aiutato e quindi vi ringrazio ugualmente

Autore

Articoli

Stai vedendo 2 articoli - dal 1 a 2 (di 2 totali)

Forum Excel VBA

[Risolto] Salvataggio file excel e chiusura file