Problème mise à jour de l'écran

[Sidonay]

Bonjour,
Je demande de l'aide au forums car j'ai un petit problème sous excel 2013.

J'ai fichier contenant une macro faisant des mises à jours d'un fichier excel vers un autre. (Précision j'ai devellopper ce fichier sous excel 2007) Cette macro contient la ligne de commande "Application.ScreenUpdating = False".

Cette macro fonctionne parfaitement bien sous 2007, mais sous 2013 elle fait la mise à jour de l'écran lors du switch entre les 2 fenêtres.
Pour être plus précis la visu du Fichier N°1 ne ce m'est pas à jour, mais on vois le basculement entre la fenêtre 1 et 2 ce qui ralentit considérablement l'execution de la macro. Ce serait sur 10 lignes ce serait supportable mais la c'est sur plus de 1000 lignes (1 basculement par ligne).

Quelqu'un a t'il une solution pour palier à se problème ?

Je tiens à préciser qu'il n'est pas possible de faire de mise à jours de mes fichiers par paquets de lignes.

 

[Efgé]

Re : Problème mise à jour de l'écran

Bonjour Sidonay

Sans fichier exemple, ni même un apperçu du code, je dirais:
Si ton écran passe d'un classeur à l'autre c'est peut être que tu as mis le Application.ScreenUpdating = False à l'intérieur d'une boucle...
Tu peux aussi éviter d'activer les fenêtres (le classeur qui porte la maro s'appel toujours "ThisWorkbook")

Cordialement

 

[Sidonay]

Re : Problème mise à jour de l'écran

Merci Efgé de t'intéréssé à mon problème.

je vais te copier/coller mon code un peu plus bas je précise aussi que je suis passé sous windows 8 es-que cela peut avoir un rapport j'en ai aucune idée.

Sub inserer_devis()

Dim compteur As Integer
Dim insert As Integer
Dim insert2 As Integer
Dim nom_devis As String
Dim Titre1 As Integer
Dim Titre2 As Integer
Dim Titre3 As Integer
Dim Titre4 As Integer
Dim GM As Integer

Application.ScreenUpdating = False

insert2 = Application.InputBox("Nombre de ligne ?", Type:=1)
insert = Application.InputBox("Ligne de départ ?", Type:=1)
nom_devis = Application.InputBox("Nom du fichier devis")
Sheets("Données d'execution").Visible = True

For compteur = insert To insert2
Windows(nom_devis & ".xls").Activate
Range("C" & compteur).Select

'insertion chapitre
If ActiveCell.Value = "T1" Then
Titre1 = 0
Titre2 = 0
Titre3 = 0
Titre4 = 0

ThisWorkbook.Activate
Sheets("Devis").Select

Sheets("Données d'execution").Select
Range("A9:BS11").Select
Selection.Copy
Sheets("Devis").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A65536").End(xlUp).Offset(-2, 2).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion titre 1
If ActiveCell.Value = "T2" Then
Titre1 = Titre1 + 1
Titre2 = 0
Titre3 = 0
Titre4 = 0
ThisWorkbook.Activate
Sheets("Devis").Select
Do While Range("BE" & ActiveCell.Row).Value <> "T2" And Titre1 > 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Select
Sheets("Données d'execution").Select
Range("a14:bS16").Copy
Sheets("Devis").Select
Selection.insert Shift:=xlDown
Application.CutCopyMode = False
Range("C" & ActiveCell.Row).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion titre 2
If ActiveCell.Value = "T3" Then
Titre2 = Titre2 + 1
Titre3 = 0
Titre4 = 0

ThisWorkbook.Activate
Sheets("Devis").Select
Do While Range("BG" & ActiveCell.Row).Value <> "T3" And Titre2 > 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Select
Sheets("Données d'execution").Select
Range("a19:bS21").Copy
Sheets("Devis").Select
Selection.insert Shift:=xlDown
Application.CutCopyMode = False
Range("C" & ActiveCell.Row).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion titre 3
If ActiveCell.Value = "T4" Then
Titre3 = Titre3 + 1
Titre4 = 0

ThisWorkbook.Activate
Sheets("Devis").Select
Do While Range("BI" & ActiveCell.Row).Value <> "T4" And Titre3 > 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Select
Sheets("Données d'execution").Select
Range("a24:bS26").Copy
Sheets("Devis").Select
Selection.insert Shift:=xlDown
Application.CutCopyMode = False
Range("C" & ActiveCell.Row).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion titre 4
If ActiveCell.Value = "T5" Then
Titre4 = Titre4 + 1
ThisWorkbook.Activate
Sheets("Devis").Select
Do While Range("BK" & ActiveCell.Row).Value <> "T5" And Titre4 > 1
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Select
Sheets("Données d'execution").Select
Range("a29:bS31").Copy
Sheets("Devis").Select
Selection.insert Shift:=xlDown
Application.CutCopyMode = False
Range("C" & ActiveCell.Row).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion article
If ActiveCell.Value = "A" Then
If GM <> 1 Then
ThisWorkbook.Activate
Sheets("Devis").Select

Application.Calculation = xlManual
ActiveCell.EntireRow.Select
Selection.insert
Sheets("Données d'execution").Select
Range("a5:bS5").Copy
Sheets("Devis").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Application.Calculation = xlAutomatic
End If

Windows(nom_devis & ".xls").Activate
Range("D" & compteur).Copy
ThisWorkbook.Activate
Range("B" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
Range("C" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("F" & compteur).Copy
ThisWorkbook.Activate
Range("D" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("H" & compteur).Copy
ThisWorkbook.Activate
Range("F" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("I" & compteur).Copy
ThisWorkbook.Activate
Range("G" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("J" & compteur).Copy
ThisWorkbook.Activate
Range("H" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("S" & compteur).Copy
ThisWorkbook.Activate
Range("Q" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("V" & compteur).Copy
ThisWorkbook.Activate
Range("T" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GM = 0
GoTo finprog
End If

'insertion ligne vide
If ActiveCell.Value = "" Then
ThisWorkbook.Activate
Sheets("Devis").Select
Application.Calculation = xlManual
ActiveCell.EntireRow.Select
Selection.insert
Sheets("Données d'execution").Select
Range("a5:bS5").Copy
Sheets("Devis").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Application.Calculation = xlAutomatic

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
Range("C" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo finprog
End If

'insertion groupement
If ActiveCell.Value = "GM" Then
GM = 1
ThisWorkbook.Activate
Sheets("Devis").Select

ActiveCell.EntireRow.Select
Sheets("Données d'execution").Select
Range("A42:BS44").Copy
Sheets("Devis").Select
Selection.insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(0, 2).Select

Windows(nom_devis & ".xls").Activate
Range("E" & compteur).Copy
ThisWorkbook.Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows(nom_devis & ".xls").Activate
Range("H" & compteur).Copy
ThisWorkbook.Activate
Range("F" & ActiveCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

finprog:
Windows(nom_devis & ".xls").Activate
If Range("A" & ActiveCell.Row).Value = "ST" Then
ThisWorkbook.Activate
Do While Range("AY" & ActiveCell.Row).Value <> "ST"
ActiveCell.Offset(1, 0).Select
Loop
End If

ThisWorkbook.Activate
Sheets("Devis").Select
ActiveCell.Offset(1, 0).Select

Next compteur

Sheets("Données d'execution").Visible = False

'suppression ligne vide
'ThisWorkbook.Activate
'For i = [C65000].End(xlUp).Row To 11 Step -1
' If Cells(i, 3) = "" Then Rows(i).Delete Shift:=xlUp
'Next i
Application.ScreenUpdating = True

End Sub

 

[chris]

Re : Problème mise à jour de l'écran

Bonjour

Sur la version 2013, Excel ouvre 2 sessions je crois d'où le problème.

Je n'ai pas d'autre solution que celle d'Efgé, que je salue, qui est de ne pas activer ou peut-être de ne pas afficher la fenêtre pendant la macro.

 

[Efgé]

Re : Problème mise à jour de l'écran

Re
Bonjour chris
Modifier ton code relève du sacerdoce
Il est inutile d'utiliser Select.
Juste un petit exemple:
A la place de

ThisWorkbook.Activate
Sheets("Devis").Select
Sheets("Données d'execution").Select
Range("A9:BS11").Select
Selection.Copy
Sheets("Devis").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Tu peux utiliser ça:

ThisWorkbook.Sheets("Données d'execution").Range("A9:BS11").Copy _
Sheets("Devis").Range("A65536").End(xlUp).Offset(1, 0)

A toi de faire la suite,
Cordialement

 

[Sidonay]

Re : Problème mise à jour de l'écran

Bonjour Chris et merci pour ton attention,
je suis d'accord avec toi le problème viens de l'ouverture de cette 2éme instance "je ne trouvais plus le mot lors de mon explication =p"

Efgé j'ai déja essayé auparavant ta solution mais VBA me renvois un message d'erreur lors de son execution comme quoi l'indice n'appartient pas à la sélection. Je ne comprend pas pourquoi d'ailleur, j'ai re-éssayer aujourd'hui pensant avoir fait une erreur en faisant un copier/coller de ton code sans succés même message qui revient.