Problema con le macro su Excel 365.

Question

Buongiorno, sto riscontrando un problema di funzionamento su alcuni file Excel contenenti delle macro. I file funzionavano regolarmente su Excel 2010 ma da quando li eseguo su 365 danno un malfunzionamento. Ho predisposto una semplice macro che chiude il file se nessuna modifica o azione viene svolta per 180 secondi. La macro funziona ma non mi permette di utilizzare le altre macro da me assegnate a dei pulsanti di chiusura con/senza salvataggio dello stesso file. Cosa posso fare?

Answer 1

Ciao Biagio Di Salvo,

Buongiorno Norman, grazie per la risposta. 

Prego!

Sono nuovo della Community e quindi non so come inviare il file contenente la macro. Oppure posso tranquillamente fare un copia/incolla della macro qui?

Potresti caricare il file problematico, dopo averlo depurato dei dati sensibili, su un servizio di condivisione di file, per esempio Microsoft OneDrive o DropBox, e postare un link al file in una risposta qui.

Per caricare il file su Microsoft OneDrive, vedi qui

Nel caso di DropBox, vedi qui

Ad ogni modo la copio qui, spero di fare la cosa giusta.

All'interno di MODULO1 ho inserito:

Public Data_Iniziale_Globale As Date

In QUESTA CARTELLA DI LAVORO:

Sub Workbook_Open()

Dim Tempo As Long 'in secondi

Dim OpenForms

' Worksheets("Corso").Activate

Tempo = 180 ' tempo in secondi

Data_Iniziale_Globale = Now

Do Until DateDiff("s", Data_Iniziale_Globale, Now) >= Tempo

    Application.StatusBar = "Se non verranno apportate modifiche questo file si chiuderà tra " & 180 - DateDiff("s", Data_Iniziale_Globale, Now) & " secondi salvando il contenuto"

    OpenForms = DoEvents

Loop

Application.StatusBar = ""

Application.DisplayAlerts = False

ThisWorkbook.Close SaveChanges:=True

Application.DisplayAlerts = True

End Sub

In FOGLIO1 (che si chiama CORSO) ho inserito:

Private Sub CloseWithSave_Click()

    Application.DisplayAlerts = True

    Application.StatusBar = ""

    ThisWorkbook.Close SaveChanges:=True

End Sub

Private Sub CloseWOutSave_Click()

Application.DisplayAlerts = True

    Application.StatusBar = ""

    ThisWorkbook.Close SaveChanges:=False

          

End Sub

Private Sub Crea_Appunt_Out_Click()

Dim Oggetto, Aula, DT_Inizio, DT_Fine As Excel.Range

Dim OutApp As New Outlook.Application

Dim appuntamento As Outlook.AppointmentItem

'aggiungere i riferimenti a Microsoft Outlook 16.0 object library

Set appuntamento = OutApp.CreateItem(olAppointmentItem)

Set Oggetto = [B4]

Set Luogo = [C8]

With appuntamento

        .Body = Oggetto

        .Subject = Oggetto

        .Start = Range("B6").Value + Range("C6").Value 'DT_Inizio

        .End = Range("B6").Value + Range("D6").Value ' DT_Fine

        .Location = Luogo

        .Display

    End With

End Sub

Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

        Data_Iniziale_Globale = Now

    Application.EnableEvents = True

End Sub

Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False

        Data_Iniziale_Globale = Now

    Application.EnableEvents = True

End Sub

Ho anche provveduto ad attivare (flag acceso) i seguenti riferimenti:

Visual Basic for Applications

Microsoft Excel 16.0 Object Library

OLE Automation

Microsoft Office 16.0 Object Library

Microsoft Forms 2.0 Object Library

Microsoft Scripting Runtime

Microsoft Outlook 16.0 Object Library

Avendo dato uno sguardo provvisorio al codice vorrei pensare che possiamo renderlo molto meno impegnativo. Ad esempio, come l'hai scritto, il codice esegue un'operazione di ciclo continuo circa 1000 volte al secondo - per dimostralo, nella procedura Workbook_Open, sostituisci:

Do Until DateDiff("s", Data_Iniziale_Globale, Now) >= Tempo

Application.StatusBar = "Se non verranno apportate modifiche questo file si chiuderà tra " & 180 - DateDiff("s", Data_Iniziale_Globale, Now) & " secondi salvando il contenuto"

    OpenForms = DoEvents

Loop.

con qualcosa del genere:

    Dim iCtr as Long

    Do Until DateDiff("s", Data_Iniziale_Globale, Now) >= Tempo

        iCtr = iCtr + 1

        Application.StatusBar = _

                   "Se non verranno apportate modifiche questo file si chiuderà tra " _

                   & 180 - DateDiff("s", Data_Iniziale_Globale, Now) _

                   & " secondi salvando il contenuto"

        Debug.Print Now & vbTab & iCtr

        OpenForms = DoEvents

    Loop

Dopo, diciamo un minuto, interrompi l'esecuzione del codice e controlla il valore della variabile iCtr nella finestra Immediata!

A prima achita, vorrei suggerire un approccio diverso del seguente genere:

Nel modulo di codice dell'oggetto ThisWorkbook (Questa_cartella_di_lavoro), incolla:

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

Option Explicit

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

Private Sub Workbook_Open()

    Data_Iniziale_Globale = Now

    Call StartTimer

    Call UpdateStatusBar

End Sub

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

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call StopTimer

    Call RestoreStatusbar

End Sub

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

Nel modulo di codice del foglio Foglio1, incolla il seguente codice:

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

Option Explicit

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

Private Sub Worksheet_Change(ByVal Target As Range)

    Data_Iniziale_Globale = Now

    Call CheckElapsedTime

End Sub

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Data_Iniziale_Globale = Now

    Call CheckElapsedTime

End Sub

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

Private Sub CloseWithSave_Click()

    Call RestoreStatusbar

    ThisWorkbook.Close SaveChanges:=True

End Sub

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

Private Sub CloseWOutSave_Click()

    Call RestoreStatusbar

    ThisWorkbook.Close SaveChanges:=False

End Sub

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

Private Sub Crea_Appunt_Out_Click()

    Dim Oggetto, Aula, DT_Inizio, DT_Fine As Excel.Range

    Dim OutApp As New Outlook.Application

    Dim appuntamento As Outlook.AppointmentItem

    'aggiungere i riferimenti a Microsoft Outlook 16.0 object library

    Set appuntamento = OutApp.CreateItem(olAppointmentItem)

    Set Oggetto = [B4]

    Set Luogo = [C8]

    With appuntamento

        .Body = Oggetto

        .Subject = Oggetto

        .Start = Range("B6").Value + Range("C6").Value    'DT_Inizio

        .End = Range("B6").Value + Range("D6").Value    ' DT_Fine

        .Location = Luogo

        .Display

    End With

End Sub

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

In un modulo standard, incolla:

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

Option Explicit

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

Public RunWhen As Double

Public Const cRunIntervalSeconds = 2   '\ 2 Secondi

Public Const cRunWhat = "CheckElapsedTime"

Public Data_Iniziale_Globale As Double

Public dElapsedTime As Double

Public Const iMassimoNumeroDiSecondi As Long = 180     '\  3 minuti

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

Public Sub StartTimer()

    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

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

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, _

                       Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

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

Public Sub CheckElapsedTime()

    dElapsedTime = DateDiff("s", Data_Iniziale_Globale, Now)

    If dElapsedTime >= iMassimoNumeroDiSecondi Then

        Call StopTimer

        Call RestoreStatusbar

        ThisWorkbook.Close SaveChanges:=True

    End If

    StartTimer

    Call UpdateStatusBar

End Sub

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

Public Sub UpdateStatusBar()

    Application.StatusBar = False

    Application.StatusBar = _

    "Se non verranno apportate modifiche questo file si chiuderà tra " _

                            & iMassimoNumeroDiSecondi - _

                            DateDiff("s", Data_Iniziale_Globale, Now) _

                            & " secondi salvando il contenuto"

End Sub

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

Public Sub RestoreStatusbar()

    Application.StatusBar = False

End Sub

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

In questo modo, credo che si raggiunga i tuoi obiettivi originali ma con un clclo molto meno impegnato, ossia con un ciclo che viene ripetuto 30 volte per minuto anzichè molte centinaia di volte al secondo.

Potresti scaricare il mio file di prova BiagioDiSalvo220170515.xlsm

===

Regards,

Norman

Answer 2

Ciao Biagio,

ho apportato piccolissime modifiche alla Macro e adesso funziona. Almeno sta funzionando nel mio ambiente di prova, oggi la proverò sulle cartelle originali (dopo averne fatto una copia di backup ovviamente :) )

Credo che l'unica modifica che sia nercessario, e il motivo per l'errore run-time 9 che hai riscontrato, sia di sostituire

    Set VBComp = VBProj.VBComponents("Sheet1")

con: 

      Set VBComp = VBProj.VBComponents("Foglio1")

Utilizzando una versione inglese di Excel, ho trascurato di modidificare il nome di codice del foglio interessato per la tua versione italiana.

Tantissime grazie ancora e ne approfitto per chiederti se hai un testo da consigliarmi per VBA in Excel.

Non credo che io possa fare di meglio che indirizzarti a due libri di John Walkenbach: 

Excel VBA Programming For Dummies

e

Excel Power Programming with VBA

A questo proposito vedi anche:

http://spreadsheetpage.com/index.php/book/C45/

Vorrei suggerire di cominciare con il primo libro e, successivamente, continuare con il secondo. In entrambi i casi, credo la versione sia di poca importanza e di solito è possibile acquistare copie di seconda mano, a buon mercato da Amazon:

http://www.amazon.com/s/ref=nb_sb_ss_i_0_15/179-5240749-2590747?url=search-alias%3Dstripbooks&field-keywords=john%20walkenbach&sprefix=john+walkenbach%2Cstripbooks%2C502&rh=i%3Astripbooks%2Ck%3Ajohn%20walkenbach&sepatfbtf=true&tc=1399240847276&ajr=sabc

===

Regards,

Norman

Answer 3

Grazie per la routine ma non ho capito dove inserire il nuovo codice che hai inviato e se durante l'elaborazione della macro devo tenere aperti dei workbook oppure no.

cioè quando e come applicare questa nuova macro?

Grazie

Regards,

Biagio

Answer 4

Buongiorno Norman, grazie per la risposta.

Sono nuovo della Community e quindi non so come inviare il file contenente la macro. Oppure posso tranquillamente fare un copia/incolla della macro qui?

Ad ogni modo la copio qui, spero di fare la cosa giusta.

Grazie.

Answer 5

Ciao Biagio Di Salvo,

Benvenuto alla Community!

sto riscontrando un problema di funzionamento su alcuni file Excel contenenti delle macro. I file funzionavano regolarmente su Excel 2010 ma da quando li eseguo su 365 danno un malfunzionamento. Ho predisposto una semplice macro che chiude il file se nessuna modifica o azione viene svolta per 180 secondi. La macro funziona ma non mi permette di utilizzare le altre macro da me assegnate a dei pulsanti di chiusura con/senza salvataggio dello stesso file. Cosa posso fare?

Senza vedere la macro problematica e almeno una delle macro assegnate ai pulsanti, lo trovo difficile rispondere, a parte dire che, sia  per Excel 2010 che per Excel 2016 (Excel 365), si tratta della medesima versione di VBA, ovvero VBA7

===

Regards,

Norman