Ruban grisé
Bonjour à tous,
J'ai un fichier central qui permet d'éditer des rapports. J'ai 2 rapports disponibles
1- sur l'activité
2- sur le prévisionnel
Les 2 partagent sensiblement le même code et pourtant
1 -
Comme vous le voyez toute la barre au-dessus est grisée, pas de ruban, pas de nom de fichier, même pas la croix pour fermer le fichier !
2-
Mais là tout va bien, je n'y comprends rien !
Si j'enregistre puis je ferme le fichier qui déconne et que je l'ouvre à nouveau, c'est bon !
J'ai essayé sur un autre ordinateur et le problème persiste
Quelqu'un a-t-il déjà eu ce genre de problème ? Une idée peut-être ?
Je vous remercie pour votre aide
Bonsoir Pink Rabbit,
Peut tu écrire sur le fichier grisé ? Apparemment tu arrives à le fermer. S'il est ouvert seul, est il aussi grisé ? Avec une simple image on ne peut donner une explication. Il faut vérifier son code, feuille et module.
Bonjour X Cellus,
Je peux remplir des cellules sur le fichier grisé. Je le ferme uniquement avec des raccourcis clavier.
Je ne peux pas vraiment l'ouvrir seul puisque le fichier se génère par code vba à partir d'un fichier mère
D'ailleurs quand j'exécute le code étape par étape je n'ai pas ce problème d'affichage...
Voici le code incriminé:
Private Sub Export_Activite()
' Exporte les données activité TTC et HT dans un classeur à part
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Fin As Integer, i As Integer, j As Integer
Dim TVA As Double
' Reset la TVA Moyenne
Application.Run Macro:="Service_Format.TVA_Moyenne"
' Dernière ligne d'activité
Fin = ThisWorkbook.Sheets("Activité").Range("ActiFin").Row
' Créé un nouveau classeur et 1er onglet = TTC
Workbooks.Add
ActiveWorkbook.ActiveSheet.Name = "TTC"
' Afficher la barre de chargement
UserFormLoading.Show 0
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=5
' Copie de la page Activité
ThisWorkbook.Sheets("Activité").Range("A:ND").Copy
' Colle en formules et format, masque B (SBGN)
With ActiveWorkbook.Sheets("TTC")
.Range("A1").PasteSpecial Paste:=xlPasteFormulas
.Range("A1").PasteSpecial Paste:=xlPasteFormats
.Range("A:A").EntireColumn.Delete shift:=xlToLeft
.Range("A:A").EntireColumn.Hidden = True
With .Range("B2")
.Value = "Activité par jour"
.Font.Size = 9
End With
With .Range("B3")
.Value = "TTC"
.Font.Bold = True
End With
.Range("C4").Select
ActiveWindow.FreezePanes = True
.Range("B1").Select
End With
' Masque le quadrillage
ActiveWindow.DisplayGridlines = False
' Copie de la feuille TTC pour faire le HT et calculer les natures en HT
ActiveWorkbook.Sheets("TTC").Copy After:=Sheets(1)
ActiveSheet.Name = "HT"
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=10
With ActiveWorkbook.Sheets("HT")
' Passer la colonne SBGN en revue
For i = 7 To Fin
If .Cells(i, 1).Value = "N" Then
' Récupérer la TVA de la nature en cours
TVA = 1 + ThisWorkbook.Sheets("CA").Range("Nature_CA").Find(.Cells(i, 2).Value, , xlFormulas, xlWhole, , , True).Offset(0, 2).Value
' Passer les 365 colonnes pour remplacer par le HT
For j = 3 To 367
.Cells(i, j).Value = .Cells(i, j).Value / TVA
Next j
' Couleur des services
ElseIf .Cells(i, 1).Value = "S" Or i = Fin Then
.Range(Cells(i, 2).Address, Cells(i, 367).Address).Interior.Color = 6961158
End If
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=10 + (i - 6) / (Fin - 7) * 20
Next i
.Range("B1:B3").Interior.Color = 6961158
.Range("B3").Value = "HT"
End With
Call Recap_Mensuel_Activite
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=100
Unload UserFormLoading
' Masque le quadrillage, full screen
ActiveWindow.DisplayGridlines = False
ActiveWorkbook.Application.WindowState = xlMaximized
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub Recap_Mensuel_Activite()
' Procédure appelée par Export_Activite
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Fin As Integer, i As Integer, j As Integer, Colonne_Debut As Integer, Colonne_Fin As Integer, Realise As Integer
Dim Previsionnel As Integer, Nb_Ligne As Integer
Dim TVA As Double
Dim Total As Long
Dim Mois(12) As String
Dim Origine As Worksheet, Destination As Worksheet
Mois(1) = "Janvier"
Mois(2) = "Fevrier"
Mois(3) = "Mars"
Mois(4) = "Avril"
Mois(5) = "Mai"
Mois(6) = "Juin"
Mois(7) = "Juillet"
Mois(8) = "Aout"
Mois(9) = "Septembre"
Mois(10) = "Octobre"
Mois(11) = "Novembre"
Mois(12) = "Decembre"
'Dernière ligne d'Activité
Fin = ThisWorkbook.Sheets("Activité").Range("ActiFin").Row
' Créé un classeur et premier onglet = "TTC"
ActiveWorkbook.Sheets.Add Before:=Sheets(1)
ActiveWorkbook.ActiveSheet.Name = "Récap TTC"
Set Origine = ThisWorkbook.Sheets("Activité") '!!!!!!
Set Destination = ActiveWorkbook.Sheets("Récap TTC")
' Copie des formats et formules des première colonnes d'activité
Origine.Range("A:Q").Copy
' Copie en formule et formats
With Destination
.Range("A1").PasteSpecial Paste:=xlPasteFormulas
.Range("A1").PasteSpecial Paste:=xlPasteFormats
' Masquer la colonne SBGN
.Range("B:B").EntireColumn.Hidden = True
.Range("A:A").EntireColumn.Delete shift:=xlToLeft
' Insérer le titre
With .Range("B2")
.Value = "Activité par mois"
.Borders(xlBottom).LineStyle = xlNone
.Font.Size = 9
End With
With .Range("B3")
.Value = "TTC"
.Font.Bold = True
.Borders(xlTop).LineStyle = xlNone
End With
.Range("C1:P1").Font.Bold = False
End With
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=35
' Passer chaque mois et faire les calculs
For i = 1 To 12
' Colonne début/fin selon plage nommée
Colonne_Debut = Origine.Range(Mois(i)).Column
Colonne_Fin = Origine.Range(Mois(i)).Column + Origine.Range(Mois(i)).Columns.Count - 1
' Compte sur la plage le nombre de jours réalisés/prévisionnels
Realise = Application.CountIf(Origine.Range(Cells(3, Colonne_Debut).Address, Cells(3, Colonne_Fin).Address), "Réalisé")
Previsionnel = Origine.Range(Mois(i)).Columns.Count - Realise
' Saisie du nom de mois
Destination.Cells(1, 2 + i).Value = Mois(i)
' Saisie du nombre de jours réalisés & Prévisionnels
With Destination.Cells(2, 2 + i)
.Value = Realise
.Font.Size = 8
If Realise < 2 Then
.NumberFormat = "0""j. Réalisé"""
Else
.NumberFormat = "0""j. Réalisés"""
End If
End With
With Destination.Cells(3, 2 + i)
.Value = Previsionnel
If Previsionnel < 2 Then
.NumberFormat = "0""j. Estimé"""
Else
.NumberFormat = "0""j. Estimés"""
End If
End With
' Somme des lignes Nature CA
With Origine
For j = 7 To Fin - 1
If .Cells(j, 2).Value = "N" Or .Cells(j, 3).Value = "Couverts" Then
Total = Application.Sum(.Range(Cells(j, Colonne_Debut).Address, Cells(j, Colonne_Fin).Address))
Destination.Cells(j, 2 + i).Value = Total
End If
Next j
End With
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=30 + i / 12 * 40
Next i
' Nombre de ligne correspond au Nb Nature + Nb Groupes + 3(CA, Couvert, Ticket Moyen)
Nb_Ligne = Application.CountA(ThisWorkbook.Sheets("CA").Range("Groupe")) + Application.CountA(ThisWorkbook.Sheets("CA").Range("Nature_CA")) + 3
' Calcul du Total annuel par la somme des natures sur la colonne 16 & Formules pour le ticket moyen
With Destination
For i = 2 To Fin - 1
If .Cells(i, 2).Value Like "*Ticket Moyen" Then
.Cells(i, 16).Formula = _
"=IFERROR(" & "P" & i - Nb_Ligne + 1 & "/P" & i - 1 & ",0)"
Else
.Cells(i, 16).Formula = _
"=SUM(" & "C" & i & ":N" & i & ")"
End If
Next i
' Formule pour la somme Ticket Moyen à part
.Range("P6").Formula = "=IFERROR(P4/P5,0)"
' Formatage de la colonne total
.Cells(1, 16).Value = "Année"
.Cells(2, 16).NumberFormat = "0""j. Réalisés"""
.Cells(3, 16).NumberFormat = "0""j. Estimés"""
.Columns(15).Clear
.Columns(15).ColumnWidth = 3
With .Range("C2:P3")
.Font.Color = 0
.Font.Size = 8
.Interior.Color = 16777215
End With
' Remettre les bordures noires latérales colonne 15 et 17
With .Range("O1:O" & Fin)
With .Borders(xlLeft)
.Color = 0
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlRight)
.Color = 0
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
End With
With .Range("Q1:Q" & Fin)
With .Borders(xlLeft)
.Color = 0
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
End With
.Range("C4").Select
ActiveWindow.FreezePanes = True
.Range("B1").Select
End With
' Masque le quadrillage
ActiveWindow.DisplayGridlines = False
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=80
' Copie de la feuille TTC pour faire le HT et calculer les natures en HT
Destination.Copy After:=Sheets(1)
ActiveSheet.Name = "Récap HT"
With ActiveWorkbook.Sheets("Récap HT")
' Passer la colonne SBGN en revue
For i = 7 To Fin
If .Cells(i, 1).Value = "N" Then
' Récupérer la TVA de la nature en cours
TVA = 1 + ThisWorkbook.Sheets("CA").Range("Nature_CA").Find(.Cells(i, 2).Value, , xlFormulas, xlWhole, , , True).Offset(0, 2).Value
' Passer les 12 colonnes pour remplacer par le HT
For j = 3 To 14
.Cells(i, j).Value = .Cells(i, j).Value / TVA
Next j
ElseIf .Cells(i, 1).Value = "S" Or i = Fin Then
.Range(Cells(i, 2).Address, Cells(i, 14).Address).Interior.Color = 6961158
.Cells(i, 16).Interior.Color = 6961158
End If
Next i
.Range("B2:B3,B1:N1,P1").Interior.Color = 6961158
.Range("B3").Value = "HT"
.Range("B1").Select
End With
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=90
ActiveWorkbook.Sheets("Récap TTC").Activate
End SubRien de vraiment spécial, je créé un classeur je colle des formats/formules d'un autre fichier et effectue quelques calculs/mises en formes...
Bjr,
Sur la première macro Export activité, insérer une ligne de code Stop avant le Call appelant une autre macro active sur le deuxième classeur. Et aussi une autre ligne de code Stop après le Call.
Ceci pour voir si Activités est grisé ou non avant le premier stop. Et de même s'il est grisé avant le deuxième stop. Donc après retour du call.
Il semblerait que ce classeur activités ne soit pas réactivé comme l'autre qui en fin de macro à une ligne de code prévue pour cela.
Phase de test continue:
Le bug n'a pas lieu si je place le ScreenUpdating = False après l'instruction : Workbooks.Add
Bug
Private Sub Export_Activite()
' Exporte les données activité TTC et HT dans un classeur à part
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Fin As Integer, i As Integer, j As Integer
Dim TVA As Double
' Reset la TVA Moyenne
Application.Run Macro:="Service_Format.TVA_Moyenne"
' Dernière ligne d'activité
Fin = ThisWorkbook.Sheets("Activité").Range("ActiFin").Row
' Créé un nouveau classeur et 1er onglet = TTC
Workbooks.Add
ActiveWorkbook.ActiveSheet.Name = "TTC"
' Afficher la barre de chargement
UserFormLoading.Show 0
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=5
Pourtant j'ai un autre code quasi-identique qui n'a pas de bug
Ne bug pas
Private Sub Export_Previsionnel()
' Exporte les données prévisionnelles TTC et HT dans un classeur à part
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Fin As Integer, i As Integer, j As Integer, Nb_Service As Integer, Nb_Segment As Integer
Dim TVA As Double
Dim Service As String
' Reset la TVA Moyenne
Application.Run Macro:="Service_Format.TVA_Moyenne"
' Fin de prévisionnel &nombre de services
Fin = ThisWorkbook.Sheets("Prévisionnel").Range("PreviFin").Row
Nb_Service = Application.CountA(Range("Service_activite"))
Nb_Segment = Application.CountA(Range("TC_segment"))
' Créé un nouveau classeur et 1er onglet = TTC
Workbooks.Add
ActiveWorkbook.ActiveSheet.Name = "TTC"
' Afficher la barre de chargement
UserFormLoading.Show 0
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=5Ca n'a aucun sens
Je viens de voir ta réponse X Cellus, je regarde ça et je reviens vers toi
A nouveau,
Ton classeur ne peut être grisé dès son ouverture donc c'est bien dans un endroit dans le programme qu'il passe grisé.
Il suffit, comme indiqué avant de placer des Stop pour voir comment il se comporte. Affichage normal jusqu'à tel ligne de code et affichage grisé à tel autre.
Tu verras alors quel ligne de code engendre le souci.
Tentative avec les stops:
Fenêtre grisée au premier stop
Fenêtre grisée au second stop
Fenêtre grisée en fin d'exécution
J'ai vérifié il me semble bien avoir une réactivation dans les 2 procédures.
Il semblerait que le problème se créé au moment du workbooks.add
D'ailleurs dans l'exécution du premier (qui bug) la fenêtre du nouveau classeur apparait durant l'exécution du code alors que le second (qui ne bug pas) la fenêtre du nouveau classeur n'apparait qu'une fois le code terminé...
Donc ce n'est pas à ce niveau du programme que le bug arrive. C'est bien avant le Call.
En isolant la portion de code qui fait basculer. Tu pourras corriger et tester ensuite.
Sans doute il vaut mieux ajouter le nouveau classeur en début de macro. Même si tu t'en sers seulement plus loin.
X Cellus
J'ai ajouté mis des stop au fur et à mesure pour voir quand apparait le bug
Tu trouveras ci-dessous le moment où le bug apparait
Private Sub Export_Activite()
' Exporte les données activité TTC et HT dans un classeur à part
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Fin As Integer, i As Integer, j As Integer
Dim TVA As Double
' Reset la TVA Moyenne
Application.Run Macro:="Service_Format.TVA_Moyenne"
' Dernière ligne d'activité
Fin = ThisWorkbook.Sheets("Activité").Range("ActiFin").Row
' Créé un nouveau classeur et 1er onglet = TTC
Workbooks.Add
ActiveWorkbook.ActiveSheet.Name = "TTC"
' Afficher la barre de chargement
UserFormLoading.Show 0
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=5
' Copie de la page Activité
ThisWorkbook.Sheets("Activité").Range("A:ND").Copy
' Colle en formules et format, masque B (SBGN)
With ActiveWorkbook.Sheets("TTC")
.Range("A1").PasteSpecial Paste:=xlPasteFormulas
.Range("A1").PasteSpecial Paste:=xlPasteFormats
.Range("A:A").EntireColumn.Delete shift:=xlToLeft
.Range("A:A").EntireColumn.Hidden = True
With .Range("B2")
.Value = "Activité par jour"
.Font.Size = 9
End With
With .Range("B3")
.Value = "TTC"
.Font.Bold = True
End With
.Range("C4").Select
ActiveWindow.FreezePanes = True
.Range("B1").Select
End With
' Masque le quadrillage
ActiveWindow.DisplayGridlines = False
' Copie de la feuille TTC pour faire le HT et calculer les natures en HT
ActiveWorkbook.Sheets("TTC").Copy After:=Sheets(1)
ActiveSheet.Name = "HT"
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=10
With ActiveWorkbook.Sheets("HT")
' Passer la colonne SBGN en revue
For i = 7 To Fin
Stop ' Là pas de bug d'affichage
If .Cells(i, 1).Value = "N" Then
Stop ' Là bug d'affichage
' Récupérer la TVA de la nature en cours
TVA = 1 + ThisWorkbook.Sheets("CA").Range("Nature_CA").Find(.Cells(i, 2).Value, , xlFormulas, xlWhole, , , True).Offset(0, 2).Value
' Passer les 365 colonnes pour remplacer par le HT
For j = 3 To 367
.Cells(i, j).Value = .Cells(i, j).Value / TVA
Next j
' Couleur des services
ElseIf .Cells(i, 1).Value = "S" Or i = Fin Then
.Range(Cells(i, 2).Address, Cells(i, 367).Address).Interior.Color = 6961158
End If
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=10 + (i - 6) / (Fin - 7) * 20
Next i
.Range("B1:B3").Interior.Color = 6961158
.Range("B3").Value = "HT"
End With
Call Recap_Mensuel_Activite
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=100
Unload UserFormLoading
' Masque le quadrillage, full screen
ActiveWindow.DisplayGridlines = False
ActiveWorkbook.Application.WindowState = xlMaximized
Application.Calculation = xlCalculationAutomatic
End SubJe ne vois pas pourquoi le passage dans la condition if cause ce bug
A nouveau,
Enlèves le premier Stop. Et déplace l'autre avant le For J. .. Le but étant de contrôler les valeurs qui sont dans la première boucle I (7 à fin) et celles après, en survolant chacune d'entre elles avec la souris.
Exemple si pour 7 pas de souci, il faut continuer valeur par valeur jusqu'à Fin. Dès qu'il y a un bug il faut déplacer le stop à la fin de la boucle J. Et idem contrôler chaque valeur du code.
C'est fastidieux mais tu cerneras mieux la survenue du bug. Et quelle valeur cela implique.
Bon alors j'ai trouvé une solution mais je ne me l'explique pas
Le problème vient de ce bout de code
For i = 7 To Fin
If .Cells(i, 1).Value = "N" Then
' Récupérer la TVA de la nature en cours
TVA = 1 + ThisWorkbook.Sheets("CA").Range("Nature_CA").Find(.Cells(i, 2).Value, , xlFormulas, xlWhole, , , True).Offset(0, 2).Value
' Passer les 365 colonnes pour remplacer par le HT
For j = 3 To 367
.Cells(i, j).Value = .Cells(i, j).Value / TVA
Next j
' Couleur des services
ElseIf .Cells(i, 1).Value = "S" Or i = Fin Then
.Range(Cells(i, 2).Address, Cells(i, 367).Address).Interior.Color = 6961158
End If
Application.Run Macro:="Affichage.UpdateProgressBar", Arg1:=10 + (i - 6) / (Fin - 7) * 20
Next i
Problème qui survient dès qu'on rentre dans la boucle (premier passage dans la boucle à partir de 10)
J'ai remplacé par une boucle for each
For Each Cellule In .Range("A7:A" & Fin)
If Cellule.Value = "N" Then
' Récupérer la TVA de la nature en cours
TVA = 1 + ThisWorkbook.Sheets("CA").Range("Nature_CA").Find(Cellule.Offset(0, 1).Value, , xlFormulas, xlWhole, , , True).Offset(0, 2).Value
' Passer les 365 colonnes pour remplacer par le HT
For j = 3 To 367
.Cells(Cellule.Row, j).Value = .Cells(Cellule.Row, j).Value / TVA
Next j
' Couleur des services
ElseIf Cellule.Value = "S" Or i = Fin Then
.Range(Cells(Cellule.Row, 2).Address, Cells(Cellule.Row, 367).Address).Interior.Color = 6961158
End If
Next Cellule
Plus de problème.
J'ai trouvé un médicament mais je connais toujours pas la maladie
Si quelqu'un a une idée pour expliquer je suis totalement preneur
Merci pour ton aide X Cellus
Bonsoir Pink Rabbit,
L'important est que tu as pu cerner le problème et apporter une solution. Sans les valeurs de sortie de chaque boucle. Il n'est pas possible de donner une hypothèse valide.
Est ce que le fait de passer à 2 chiffres dans la première boucle (10) posait un souci dans les lignes suivantes? Alors que de 7 à 9 tout se passait bien.
Je vois aussi que tu as supprimé en fin de macro l'appel à la barre de progression qui existait auparavant. Sans doute l'as tu placé après le dernier next.
Bonne continuation.