Stellar Blade Un'esclusiva PS5 che sta facendo discutere per l'eccessiva bellezza della protagonista. Vieni a parlarne su Award & Oscar!
 
Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email     « Discussione Precedente | Lista | Discussione Successiva »
Autore

salva workbook in formato xlsx

Ultimo Aggiornamento: 28/06/2022 11:16
giova62
Post: 35
Registrato il: 29/04/2021
Città: CITTADELLA
Età: 62
Utente Junior
365/2007
OFFLINE
20/06/2022 16:24
00#1
Ciao a tutti.
Nella macro in thisworkbook c'è una parte che salva in formato txt chi accede al workbook in una cartella esterna,
E' possibile che il formato sia in xlsx? 


Option Explicit





Dim modificato As Boolean


 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
    modificato = True
 
End Sub



'================================================================
'================================================================




Private Sub Workbook_Open()
   
 
     Dim fogli As Worksheet
     Dim Ur As Long
   
 '-----------------------------------------------------------------------
'per username - chi apre
Sheets("Utenti_Errori").Unprotect "987654"
Sheets("Utenti_Errori").Cells(2, 6).Value = Environ("UserName") 'F2
Sheets("Utenti_Errori").Protect "987654"
'------------------------------------------------------------------------

'---------------------------------------------------------------------
'per utilizzare i filtri automatici in fogli protetti

    Foglio1.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio1.EnableAutoFilter = True
   
    Foglio2.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio2.EnableAutoFilter = True
   
    Foglio3.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio3.EnableAutoFilter = True
   
    Foglio4.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio4.EnableAutoFilter = True
   
    Foglio5.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio5.EnableAutoFilter = True
   
    Foglio11.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    Foglio11.EnableAutoFilter = True
   

   
'---------------------------------------------------------------------
             
   
'---------------------------------------------------------------------------
'ACCESSI
 
 
    Dim CurFolder, DestFolder As String
    Dim name1 As String
    Dim Urec   As String
   
    'Dim accessi  As String
    'name1 = Foglio6.Range("G2").Value
   
    Application.ScreenUpdating = False
   
    'name1 = Foglio2.Range("Z1").Value
    name1 = "accessi a " & Foglio11.Range("A2").Value
 
    CurFolder = ActiveWorkbook.Path
   
    DestFolder = CurFolder & "\" & name1 & "\"
   
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   
    Open DestFolder & "\accessi.log" For Append As #1
   
    Print #1, Application.UserName, Now & " ACCESSO"
   
    Close #1
   
    Application.ScreenUpdating = True
  '---------------------------------------------------------------------------
   
     
  '---------------------------------------------------------------------------
   
  '---------------------------------------------------------------------------
 
   
   
   

 
 
  Sheets("Input").Activate '<<< per aprire direttamente in Input
 
 
 
  Application.ScreenUpdating = True
 
 
 
 
End Sub








Private Sub Workbook_BeforeClose(Cancel As Boolean)

 
 Dim name1 As String, name2 As String, name3 As String, name4 As String, name5 As String
 Dim sPath As String, sComm5 As String, sComm6 As String, sComm7 As String, sComm8 As String
   
   
    Dim fogli As Worksheet
 
    Dim iUserResponse   As Integer

    Dim risposta1   As String
    Dim risposta2   As String
    Dim risposta3   As String
    Dim sStatus         As String
 
    Dim val1 As String
    Dim val2 As String
    Dim val3 As String
   
   
    Dim CurFolder As String
    Dim DestFolder As String
    Dim risposta As String
    Dim Urec   As String
             
'------------------------------------------------------------------------------------------------------
'per utente autorizzato


Dim avviso As String
Dim cercarange As Range

   

    Set cercarange = Foglio8.Range("E2:E11").Find(Foglio8.Range("F2"))
   

    If cercarange Is Nothing Then
 
 
      ' MsgBox "Value not found"
      avviso = MsgBox(Environ("UserName") & " non sei autorizzato a modificare questo workbook", vbCritical + vbDefaultButton2, "AVVISO!")

        If avviso = vbOK Then
       
       
       
'-----------------------------------------------------------------
       
    'Dim CurFolder, DestFolder As String
    'Dim name1 As String
    'Dim Urec   As String
   
    'Dim accessi  As String
    'name1 = Foglio6.Range("G2").Value
    'name1 = "accessi"
   
    name1 = "accessi a " & Foglio11.Range("A2").Value
   
    CurFolder = ActiveWorkbook.Path
       
    DestFolder = CurFolder & "\" & name1 & "\"
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   


Open DestFolder & "\accessi.log" For Append As #1


Urec = Cells(Rows.Count, 1).End(xlUp).Row + 1

 
 
Print #1, Application.UserName, Now & " CHIUSURA non modificato" '& ciao

 
   
    Print #1, "------------------------------------------------------------"
    Close #1
   
'----------------------------------------------------------------------
       

      Me.Saved = True

Exit Sub


    ' MsgBox "Value not found"
    'ThisWorkbook.Saved = True
    ' ThisWorkbook.Close


    Else

        'MsgBox foundRng.Address

    End If


End If

'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
   
'---------------------------------------------------------------------------
 
   
 
 '------------------------------------------------------------------------------------------
'backup

    name5 = Foglio11.Range("A2").Value
 
   sComm5 = "BACKUP"
   sComm6 = Foglio11.Range("A2").Value
 
   sComm7 = sComm6  'Foglio6.Range("B3").Value
   sComm8 = sComm5 & " - " & sComm6 'Foglio6.Range("B3").Value
 

If MsgBox("Sign. " & Environ("UserName") & " vuoi il backup di:" & Chr(13) & Chr(13) & _
"< " & sComm6 & " >?", vbQuestion + vbYesNo + vbDefaultButton2, "AVVISO!") = vbYes Then
 
     
   sPath = ThisWorkbook.Path & "\" & sComm8
    If Dir(sPath, vbDirectory) = "" Then MkDir sPath
   
   'sPath = sPath & "\" & sComm7
    'If Dir(sPath, vbDirectory) = "" Then MkDir sPath
   
   'sPath = sPath & "\" & sComm6
    'If Dir(sPath, vbDirectory) = "" Then MkDir sPath
   
   
  ThisWorkbook.SaveCopyAs sPath & "\" & Format(Now, "dd-mm-yyyy - hh.mm") & " - " & ActiveWorkbook.Name '<<< data/ora

End If
       
   ' End If
                                   
                   
 '--------------------------------------------------------------------------
                   
 '--------------------------------------------------------------------------
 '
 '--------------------------------------------------------------------------

 

'---------------------------------------------------------------------------
 'ACCESSI/FINE SESSIONE

   
    'Dim name1 As String, name2 As String          'modificata
    'Dim CurFolder As String
    'Dim DestFolder As String
    'Dim risposta As String
 
 
 
 
 Application.DisplayAlerts = False
 
 
    'name1 = Foglio2.Range("Z1").Value
    'name2 = Foglio2.Range("Z3").Value
    name1 = "accessi a " & Foglio11.Range("A2").Value
   
    CurFolder = ActiveWorkbook.Path
    DestFolder = CurFolder & "\" & name1 & "\"
   
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   
    Open DestFolder & "\accessi.log" For Append As #1
   
    If modificato = True Then
   
        risposta = MsgBox("Salvare le modifiche apportate a '" & name1 & "' ?", vbExclamation + vbYesNoCancel, "Microsoft Office Question")
       
        Select Case risposta
       
            Case Is = vbYes
                'file modificato e salvato
                Print #1, Application.UserName, Now & " CHIUSURA" & " modificato "
                ThisWorkbook.Save
               
            Case Is = vbNo
                'file modificato ma non salvato
                Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
                ThisWorkbook.Saved = True
               
            Case Is = vbCancel
                'uscita annullata
                Cancel = True                     'annullo l'evento Close
                Close #1                          'chiudo il file accessi.log
                Exit Sub                        'abbandono la macro
               
        End Select
       
    Else
   
   
   
   
        'file non modificato
        Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
    End If
    Print #1, "-------------------------------------------------------------"
    Close #1
           
     
   
     'Application.EnableEvents = False              'disabiliti il controllo degli eventi
     'ActiveWorkbook.Close False                    '<<< aggiunta
     'Application.EnableEvents = True               'riabiliti il controllo degli eventi
         
     Cancel = True
     CloseNoSave
 
   
'------------------------------------------------------------------------------------------------------       
        
   
 
End Sub


Private Sub CloseNoSave()

Application.EnableEvents = False
ThisWorkbook.Close SaveChanges:=False
Application.EnableEvents = True

End Sub



La parte che inserisce il formato txt è:

in Private Sub Workbook_Open() 

'---------------------------------------------------------------------------
'ACCESSI
 
 
    Dim CurFolder, DestFolder As String
    Dim name1 As String
    Dim Urec   As String
   
    'Dim accessi  As String
    'name1 = Foglio6.Range("G2").Value
   
    Application.ScreenUpdating = False
   
    'name1 = Foglio2.Range("Z1").Value
    name1 = "accessi a " & Foglio11.Range("A2").Value
 
    CurFolder = ActiveWorkbook.Path
   
    DestFolder = CurFolder & "\" & name1 & "\"
   
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   
    Open DestFolder & "\accessi.log" For Append As #1
   
    Print #1, Application.UserName, Now & " ACCESSO"
   
    Close #1
   
    Application.ScreenUpdating = True
  '---------------------------------------------------------------------------


in Private Sub Workbook_BeforeClose(Cancel As Boolean) 

'-----------------------------------------------------------------
'ACCESSI/UTENTE AUTORIZZATO
       
    'Dim CurFolder, DestFolder As String
    'Dim name1 As String
    'Dim Urec   As String
   
    'Dim accessi  As String
    'name1 = Foglio6.Range("G2").Value
    'name1 = "accessi"
   
    name1 = "accessi a " & Foglio11.Range("A2").Value
   
    CurFolder = ActiveWorkbook.Path
       
    DestFolder = CurFolder & "\" & name1 & "\"
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   


Open DestFolder & "\accessi.log" For Append As #1


Urec = Cells(Rows.Count, 1).End(xlUp).Row + 1

 
 
Print #1, Application.UserName, Now & " CHIUSURA non modificato" '& ciao

 
   
    Print #1, "------------------------------------------------------------"
    Close #1
   
'----------------------------------------------------------------------

'---------------------------------------------------------------------------
 'ACCESSI/FINE SESSIONE

   
    'Dim name1 As String, name2 As String          'modificata
    'Dim CurFolder As String
    'Dim DestFolder As String
    'Dim risposta As String
 
 
 
 
 Application.DisplayAlerts = False
 
 
    'name1 = Foglio2.Range("Z1").Value
    'name2 = Foglio2.Range("Z3").Value
    name1 = "accessi a " & Foglio11.Range("A2").Value
   
    CurFolder = ActiveWorkbook.Path
    DestFolder = CurFolder & "\" & name1 & "\"
   
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
   
    Open DestFolder & "\accessi.log" For Append As #1
   
    If modificato = True Then
   
        risposta = MsgBox("Salvare le modifiche apportate a '" & name1 & "' ?", vbExclamation + vbYesNoCancel, "Microsoft Office Question")
       
        Select Case risposta
       
            Case Is = vbYes
                'file modificato e salvato
                Print #1, Application.UserName, Now & " CHIUSURA" & " modificato "
                ThisWorkbook.Save
               
            Case Is = vbNo
                'file modificato ma non salvato
                Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
                ThisWorkbook.Saved = True
               
            Case Is = vbCancel
                'uscita annullata
                Cancel = True                     'annullo l'evento Close
                Close #1                          'chiudo il file accessi.log
                Exit Sub                        'abbandono la macro
               
        End Select
       
    Else
   
   
   
   
        'file non modificato
        Print #1, Application.UserName, Now & " CHIUSURA" & " non modificato "
    End If
    Print #1, "-------------------------------------------------------------"
    Close #1
   
         
     
   
     'Application.EnableEvents = False              'disabiliti il controllo degli eventi
     'ActiveWorkbook.Close False                    '<<< aggiunta
     'Application.EnableEvents = True               'riabiliti il controllo degli eventi
   
   
   
     Cancel = True
     CloseNoSave


Allego workbook.
Grazie
by sal
Post: 6.853
Registrato il: 14/11/2004
Utente Master
Office 2019
OFFLINE
21/06/2022 12:29
00#2
Ciao ma se ti salva il file in *.xlsx non ti salva le macro che sono all'interno ti salva solamente i dati.

Ciao By Sal (8-D
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
L2018
Post: 303
Registrato il: 02/04/2018
Città: PESCARA
Età: 75
Utente Senior
EXCEL 2016 - SPREAD32
ONLINE
21/06/2022 13:52
00#3
ma neanche in XLSX, che sarebbe da Excel 2007 in poi, addirittura lo salva in XLS

Evidentemente non sa che per salvare un Foglio dotato di macro, e non perdere la macro, deve andare in

- Salva con nome

- Cartella di lavoro con attivazione macro di Excel

- confermare o cambiare il nome del foglio e confermare il formato XLSM

LEO

LEO
https://t.me/LordBrum
rollis13
Post: 1.210
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Veteran
Excel 2016-32bit Win11
OFFLINE
21/06/2022 14:40
00#4
Un saluto a tutti.
In realtà io ho capito che è il file 'accessi.log' che andrebbe creato e salvato come 'accessi.xlsx' ma secondo me c'è parecchio lavoro da fare per realizzare questa rivoluzione nel progetto. Come dice qualcuno dotato di ruote: "E' tutto da rifare".
[Modificato da rollis13 21/06/2022 14:42]

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
giova62
Post: 35
Registrato il: 29/04/2021
Città: CITTADELLA
Età: 62
Utente Junior
365/2007
OFFLINE
21/06/2022 20:42
00#5
Ciao a tutti.
Si è come dice rollis13.
Il file xlsx deve sostituire il file txt che ora si crea con le macro.
Il file xlsx non deve avere nessuna macro, è un file di dati come il file txt
giova62
Post: 36
Registrato il: 29/04/2021
Città: CITTADELLA
Età: 62
Utente Junior
365/2007
OFFLINE
27/06/2022 20:51
00#6
Ciao,
qualcuno ha capito come risolvere?
dodo47
Post: 3.314
Registrato il: 06/04/2013
Utente Master
2010
OFFLINE
28/06/2022 11:16
00#7
ciao
ti do uno spunto per quanto riguarda l'open, nel caso che la cartella "accessi a file accessi" ed il file "accessi.xlsx" non esistano 

......
........
    CurFolder = ActiveWorkbook.Path
    
    DestFolder = CurFolder & "\" & name1 & "\"
    
    'se non esiste la cartella "accessi a" non esiste nemmeno il file _
     crea tutto:
    If Dir(DestFolder, vbDirectory) = "" Then
        MkDir DestFolder
        Set wb = Workbooks.Add
        With wb
        .Sheets(1).Name = "log_Accessi"
        .Sheets(1).Cells(1, 1) = Application.UserName
        .Sheets(1).Cells(1, 2) = Now
        .Sheets(1).Cells(1, 3) = " ACCESSO"
        .SaveAs DestFolder & "accessi.xlsx"
        .Close
        End With
    Else
        'la cartella esiste
        se esiste il file......
       ............ 
        se non esiste il file.....
       .......... 
    End If
.....


Domenico
Win 10 - Excel 2016
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Cerca
nei titoli, nei messaggi, con Google
Tag discussione
workbook formato
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 10:41. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com

  • Anteprima