Microsoft 365 affichage bizarre à la fermeture de mon "usine à gaz"

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous :)

A la fermeture de mon fichier, j'ai un affichage bizarre lol :)
Je suis sur la feuille de mon classeur affichage normal :
1669198500925.png

Quand je ferme mon fichier, j'ai cette affichage :
(uniquement sur les 2 premières lignes les autres restant affichées normalement)
1669198553483.png

Voici mon code de fermeture :
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False

    Sheets("Repondeurs").Unprotect Password:="Krameri"
    Sheets("Repondeurs").Range("ac1") = ""
    ClearClipboard1

    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
    Trie_Appels

    With Application 'plein écran
    .WindowState = xlMaximized 'window max
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Sheets("A Faire").Select
    ActiveWorkbook.Save
    If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub
Avez déjà rencontré ce "truc" ? lol :)
Ce n'est pas gênant et aucune influence sur le fichier et mes feuilles, tout fonctionne bien mais ça "m'énerve :mad:" depuis très longtemps.

Merci pour vos retours
:)
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Bonjour Lionel,
En PJ un essai en reproduisant votre macro.
Evidemment ClearClipboard1 et Trie_Appels sont vides.
Apparemment tout se passe bien à la fermeture. Pouvez vous tester ?
Regarde la pièce jointe 1156157
Re-Bjr :)
Avec ton fichier = pas de souci...
Je mets ton code dans mon fichier et le problème est tjrs là.
J'ai aussi un beug :
1669200515231.png

:)
Mais on ne trouve pas, pas de souci : ça "m'énerve grave" lol mais aucune incidence sur le fonctionnement du fichier...
:)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Si vous avez une erreur sur cette ligne, c'est qu'il y a un souci avec Workbooks.count.
Juste pour voir, testez en supprimant cette ligne et en remplaçant la dernière ligne par Application.Quit.
Est ce que ça marche ?
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False

    Sheets("Repondeurs").Unprotect Password:="Krameri"
    Sheets("Repondeurs").Range("ac1") = ""
    ClearClipboard1

    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
    Trie_Appels

    With Application 'plein écran
    .WindowState = xlMaximized 'window max
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Sheets("A Faire").Select
    ActiveWorkbook.Save
    Application.Quit
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Re,
Si vous avez une erreur sur cette ligne, c'est qu'il y a un souci avec Workbooks.count.
Juste pour voir, testez en supprimant cette ligne et en remplaçant la dernière ligne par Application.Quit.
Est ce que ça marche ?
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False

    Sheets("Repondeurs").Unprotect Password:="Krameri"
    Sheets("Repondeurs").Range("ac1") = ""
    ClearClipboard1

    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
    Trie_Appels

    With Application 'plein écran
    .WindowState = xlMaximized 'window max
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Sheets("A Faire").Select
    ActiveWorkbook.Save
    Application.Quit
End Sub
Merci encore pour le retour :)
Le code ci-dessus fonctionne sans souci...
Les 2 premières lignes apparaissent tjrs grisées mais ça revient plus vite à l'affichage normal.
C'est déjà une avancée = ça m'énerve moins lol
:)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Donc le souci vient de Workbooks.count, puisque la ligne [A1]=Workbooks.count est correcte, dans l'absolu.
Reste à savoir pourquoi ?
Testez cette macro, vous en aurez le cœur net. Un message vous avertira s'il trouve une erreur.
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False

    Sheets("Repondeurs").Unprotect Password:="Krameri"
    Sheets("Repondeurs").Range("ac1") = ""
    ClearClipboard1

    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
    Trie_Appels

    With Application 'plein écran
    .WindowState = xlMaximized 'window max
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Sheets("A Faire").Select
    Erreur = IsError(Workbooks.Count)
    ActiveWorkbook.Save
    If Erreur = True Then MsgBox = "Erreur sur Workbooks.Count"
    If Erreur = True Or Workbooks.Count = 1 Then
        Application.Quit
    Else
        ThisWorkbook.Close
    End If
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Donc le souci vient de Workbooks.count, puisque la ligne [A1]=Workbooks.count est correcte, dans l'absolu.
Reste à savoir pourquoi ?
Testez cette macro, vous en aurez le cœur net. Un message vous avertira s'il trouve une erreur.
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False

    Sheets("Repondeurs").Unprotect Password:="Krameri"
    Sheets("Repondeurs").Range("ac1") = ""
    ClearClipboard1

    ActiveWindow.DisplayHeadings = True
     With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlToRight
    Application.MoveAfterReturnDirection = xlToRight
    End With
    Trie_Appels

    With Application 'plein écran
    .WindowState = xlMaximized 'window max
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Sheets("A Faire").Select
    Erreur = IsError(Workbooks.Count)
    ActiveWorkbook.Save
    If Erreur = True Then MsgBox = "Erreur sur Workbooks.Count"
    If Erreur = True Or Workbooks.Count = 1 Then
        Application.Quit
    Else
        ThisWorkbook.Close
    End If
End Sub
Re-Bjr :)
beug ici :
1669202692569.png

:)
 

Discussions similaires

Statistiques des forums

Discussions
314 711
Messages
2 112 125
Membres
111 430
dernier inscrit
rebmania67