Microsoft 365 Gros problème de ralentissement au lancement d'un inputbox

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,
Je vous souhaite une belle journée :)

Je reviens vers nos ténors car j'ai un grave souci :mad:
Notre fichier de travail à toujours eu quelques ralentissement quand nous lançons un inputbox.
Mais depuis quelques temps, ça devient catastrophique.
Notamment au lancement de l'inputbox de recherche.
C'est devenu quasiment permanent ... 10 à 15 minutes d'attente à chaque lancement et ça toute la journée. Cela nous bloque dans notre travail.

A force de recherches, j'ai pensé qu'il s'agissait d'un souci de mémoire.
Selon mes lectures internet, pensant que la mémoire pourrait être libérée au fur et à mesure, j'ai ajouté à la fin des instructions Set ... :"Set ... = Nothing"
Malheureusement sans succès.

En fait, il semblerait que ce soit l'utilisation du Processeur qui soit en cause car
il passe pendant les blocages à plus de 47% d'utilisation alors que normalement il ne dépasse pas les 5%.

Je joins les éléments suivants :
- l'image info disque qui montre un espace libre de 327 Go,
- l'image info du système,
- l'image de l'état du processeur aux moments des bugs de ralentissement,
- le code de l'UserForm de recherche,
VB:
Sub Recherche_youky()
nom = InputBox("Cherche N° Client :" & Chr(10) & "      - Si pas de n°," & Chr(10) & "            - ou erreur n°," & Chr(10) & "                  Recommencez !", "Recherche")
If nom = "" Then
[a6].Select
Sheets("format-numero").Visible = False
Exit Sub
End If
Sheets("format-numero").Range("h3") = ""
  q = ActiveSheet.Index
  For q = q To ActiveSheet.Index + Sheets.Count - 1
    K = (q - 1) Mod (Sheets.Count) + 1
With Sheets(K).UsedRange
Application.ScreenUpdating = False
Range([g2], Cells(Rows.Count, "h").End(xlUp)).Activate
Set C = .Find(nom, LookAt:=xlPart)   'LookAt:=xlpart dans cellule - LookAt:=xlWhole) 'cellule entière
[a1].Activate
If Not C Is Nothing Then
firstAddress = C.Address
Do
On Error Resume Next
Sheets(K).Select
C.Activate
    Application.ScreenUpdating = True
    ActiveWindow.ScrollRow = Selection.Row
    If ActiveSheet.Name = "CopieAppels" Then
    Selection.RowHeight = 50
    End If

    If ActiveSheet.Name = "SuivisAppels" Then
    If Cells(ActiveCell.Row, 7) = C Or Cells(ActiveCell.Row, 8) = C Then

    Rows("6:6").Copy
    Cells(ActiveCell.Row, 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.RowHeight = 300

    End If
    End If
    Cells(ActiveCell.Row, 1).Select

If ActiveSheet.Name = "SuivisAppels" And Cells(ActiveCell.Row, 7) <> C And Cells(ActiveCell.Row, 8) <> C Then
rep = MsgBox(ActiveSheet.Name & " votre N° : " & C & " est absent ! Continuer la recherche ?", 4 + 32, "Sélection")
Sheets("format-numero").Visible = False
Else
rep = MsgBox(C & " : OK dans " & ActiveSheet.Name & Chr(10) & "" & Chr(10) & "Cellule - ligne :  " & C.Address & Chr(10) & Chr(10) & "" & "Continuer la recherche ?", 4 + 32, "Résultat")
End If
If rep = vbNo Then
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
Exit Sub
End If
Application.ScreenUpdating = False
Sheets("format-numero").Range [h3] = ""
Sheets("format-numero").Visible = False
If ActiveSheet.Name = "CopisAppels" Then
Sheets("SuivisAppels").Select
End If
Application.ScreenUpdating = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
  Next q
MsgBox "Ben NON : y'a pas ou y'a plus !"
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
End Sub
Profane complet en la matière, je ne sais plus quoi faire.
Auriez-vous des idées, solutions ou pistes vers où me diriger ?

Avec mes remerciements,
Amicalement,
lionel,
 

Pièces jointes

  • infos_disque.jpg
    infos_disque.jpg
    30.6 KB · Affichages: 65
  • infos_systeme.jpg
    infos_systeme.jpg
    105.3 KB · Affichages: 35
  • gestionnaire taches.jpg
    gestionnaire taches.jpg
    127.7 KB · Affichages: 34
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Re

=>Usine à gaz
[Pour infos]
La procédure affectée au bouton bordé de rouge ce n'est pas:
Sub Recherche_youky()
mais celle-ci
Code:
Public Sub BoutonRecherche()
If Cells(Rows.Count, "a").End(xlUp)(1).Offset(0, 16) <> "" And [t3] <> "OK" Then
    Blocage
    Exit Sub
        Else
        Application.EnableEvents = False
    Application.ScreenUpdating = False
    '[a6].Select
        SupprimeLignes 'si dernière ligne totalement à remplir
        If [t3] <> "OK" Then
        Exit Sub
        End If
        Application.EnableEvents = False
        Application.ScreenUpdating = False
       
        Application.Calculation = xlManual
        Rows("6:6").Select
        Selection.AutoFilter
        Range("a6").Select
        Range("a7:u" & Range("A" & Rows.Count).End(xlUp).Row).ClearFormats
        Cells(ActiveCell.Row, 1).Select
            With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
        Range([w7], Cells(Rows.Count, "z").End(xlUp)).ClearFormats
        Range([a7], Cells(Rows.Count, "a").End(xlUp)).RowHeight = 40
        Range([J7], Cells(Rows.Count, "j").End(xlUp)).NumberFormat = "General"
        Range([y7], Cells(Rows.Count, "y").End(xlUp)).NumberFormat = "General"
        Application.Calculation = xlAutomatic
        Remonte
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        End If
           
    DebloqueFeuilles
    Sheets("format-numero").Visible = True
   
        Sheets("format-numero").Select
        Application.EnableEvents = False
        Application.ScreenUpdating = False
       
        Range("H3").Select
'        [h3] = ""
        On Error Resume Next
        With [h3]
            ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
        End With

            On Error Resume Next
            ActiveCell.Replace " ", "", xlPart
            ActiveCell.Replace ".", "", xlPart
            ActiveCell.Replace "-", "", xlPart
            ActiveCell.Replace "/", "", xlPart
            ActiveCell.Replace ";", "", xlPart
            ActiveCell.Replace ",", "", xlPart
            ActiveCell.Replace ":", "", xlPart
            ActiveCell.Replace "_", "", xlPart

'            If [h3] > 1 And [h3] < 100000000# Then
'            [h3].Value = [h3].Value
'            End If
           
            If [h3] > 999999999# Then
            [h3].Value = [h3].Value
            End If
           
            If [h3] > 100000000# And [h3] < 1000000000# Then
            [h3].Value = 33 & [h3].Value
            End If

            [h3].Select
            [h3].Copy

    Sheets("SuivisAppels").Select
    If Cells(Rows.Count, "a").End(xlUp)(1).Offset(0, 17) = "" And [t3] <> "OK" Then
    SupprimeLignes 'si dernière ligne totalement à remplir
    'Application.Calculation = xlAutomatic
    Remonte
    Application.EnableEvents = True
    End If
'----------------------------------------------
Application.ScreenUpdating = False
Application.EnableEvents = False
    Recherche_youky
    Cells(ActiveCell.Row, 7).Select
    ClearClipboard1
'----------------------------------------------
If [as1] = "Haut Bas" Then 'est sur le n°"
    ActiveWindow.ScrollRow = Selection.Row
    Selection.Copy
    [H1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    [J1].FormulaR1C1 = "N° Client"
    [AW2].FormulaR1C1 = "=IF(OR(R1C8=RC[-42],R1C8=RC[-41]),1,"""")"
    [AW2].Copy
    [AW3:AW20000].PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    [AW2:AW20000].Copy
    [AW2:AW20000].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("2:20000").Hidden = True
    On Error Resume Next
    [AW2:AW20000].SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = False
    Range("AW2:AW20000").Select
    Selection.ClearContents
    Range("h1").Select
    Selection.ClearContents
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "N° Client"
    Cells(ActiveCell.Row, 1).Select
End If
Application.EnableEvents = False
'Masque boutons si N° dans feuille SuivisAppels
If ActiveSheet.Name = "CopieAppels" Then
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Range("g2:g" & Range("S65536").End(xlUp).Row).SpecialCells(xlVisible).Select
ActiveCell.Select
Dim x As Range
Set x = Sheets("SuivisAppels").Range("g7:h20000").Find(ActiveCell, , xlValues, xlPart, , , False)
If Not x Is Nothing Then 'si trouve
ActiveSheet.Shapes("CopieAppels_Button 1").Visible = False
ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = False
[s1] = "Ci-dessous vos commentaires :" & Chr(10) & _
"Votre N° est également dans votre feuille ""SuivisAppels""" & Chr(10) & _
"Allez dans votre feuille pour le traiter"
End
Else
ActiveSheet.Shapes("CopieAppels_Button 1").Visible = True
ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = True
   [s1] = "La ligne de ce N° n'est pas ou plus dans ""SuivisAppels"". Pour la réintégrer :" & Chr(10) & _
   "1 - Si plusieurs lignes sont affichées pour le même n°, Choisissez en cliquant dans une cellule de la ligne du dernier appel" & Chr(10) & _
   "2 - Clic sur bouton ""Réintègrez votre Appel"", la ligne sera transférée en dernière ligne"
'MsgBox ("IMPORTANT : Si vous quittez CopieAppels avant réintégration, vous devrez refaire votre recherche pour retrouver votre ligne" & nbcel)
CreateObject("Wscript.shell").Popup "Si vous quittez CopieAppels avant réintégration," & Chr(10) & _
"vous devrez refaire votre recherche pour retrouver votre ligne", 1, "IMPORTANT :"
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
'Application.Calculation = xlAutomatic
End Sub
- Si je lance la macro "Public Sub BoutonRecherche()" = ça beugue (ralentissement),
- si j'éxécute à partir du débogage = ça beugue pas,
Incompréhensible pour moi :mad:
 

Staple1600

XLDnaute Barbatruc
Re

Concernant ce que je dis par rapport au bouton bordé de rouge?

[Précisions sur ce que je disais plus bas]
C'est cette partie du code du WorkBook_Open()
qu'il aurait fallut mettre en commentaire avant de joindre ton fichier
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Application.CommandBars("Formatting").Enabled = False
Application.CommandBars("Cell").Enabled = False
'ActiveWindow.DisplayHorizontalScrollBar = False
'ActiveWindow.DisplayVerticalScrollBar = False
Application.DisplayFormulaBar = False
With Application
.WindowState = xlMaximized 'window max
End With
Le plus simple ou sur étant de mettre tout le code de ThisWorkBook en commentaire.
 

Usine à gaz

XLDnaute Barbatruc
Re

Concernant ce que je dis par rapport au bouton bordé de rouge?

[Précisions sur ce que je disais plus bas]
C'est cette partie du code du WorkBook_Open()
qu'il aurait fallut mettre en commentaire avant de joindre ton fichier

Le plus simple ou sur étant de mettre tout le code de ThisWorkBook en commentaire.
Tu as certainement raison mais j'ai pensé que ce serait mieux de mettre le fichier dans l'intégralité de son utilisation :)
 

fanch55

XLDnaute Barbatruc
Bonjour à tous,
sur mon Excel 2016 64 bits avec 16 mo de mémoire et une carte mère de type ordinateur fixe ( pas portable ),
aucun ralentissement quand je fais une recherche .
Il faut dire que comme je ne sais pas quoi chercher, j'ai quasi immédiatement le message comme quoi ce n'est pas trouvé .
J'ai essayé de tracer les modules( après les avoir débloqué ), mais je dois avouer que je m'y perd, d'autant plus que je n'ai pas trouvé l'Userform fautif ... :mad:
 

Usine à gaz

XLDnaute Barbatruc
Bonjour fanch55,

Merci de t'être penché sur mon "usine à gaz" :)

En fait le blocage est à plusieurs niveaux :
- la fenêtre de la recherche ne s'affiche pas et ça mouline (souvent jusqu'à 15mn d'attente),
- et après affichage, on n'a pas la main pour rentrer l'objet de la recherche (encore jusqu'à 15 mn d'attente),
lionel,
 

Staple1600

XLDnaute Barbatruc
Bonsoir fanch55

sur mon Excel 2016 64 bits avec 16 mo de mémoire et une carte mère de type ordinateur fixe ( pas portable ),
Tu voulais dire Go, je suppose ? ;)

Sinon, je vois que je ne suis pas le seul que la profusion et le multitude pertube ;)
J'ai essayé de tracer les modules( après les avoir débloqué ), mais je dois avouer que je m'y perd,

=>Usine à gaz
Mais il y a un truc que je ne pige pas.
Tu parles d'userform dans ton premier message, mais dans la macro associée au bouton sur la feuille SuiviAppels (donc Public Sub BoutonRecherche()) n'affiche pas d'userform, sauf erreur de ma part?
 

Usine à gaz

XLDnaute Barbatruc
JM, oui, je me suis trompé ce n'est pas un UserForm c'est la fenêtre de la recherche.

Ce qui est à chercher, ce sont des n° de téléphone.
Dans la feuille SuivisAppels, il y a 2 lignes.

Les N° à chercher sont :
- 33000000003 ou 33000009003,
- 33000000005ou 33000009005,
lionel :)
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Ben, quand je clique sur le carré de cadre rouge, je n'arrive pas pas à un userform mais un inputbox dans recherche_youki ( comme Staple ) .
Dans recherche_youki, je pense que tu devrais déjà corriger ton Find avec un Sélection.find puisque tu as fait un activate juste avant ..
Set C = Selection.Find(nom, LookAt:=xlPart) 'LookAt:=xlpart dans cellule - LookAt:=xlWhole) 'cellule entière
ou tu fais un find sur la colonne concernée mais surtout pas la feuille entière
 

Staple1600

XLDnaute Barbatruc
Re

=>Usine à gaz
Il n'y a pas de feuille SaisiAppels
Le bouton dont on parle est sur la feuille SuiviAppels

Question au passage:
Tu utilises la procédure de job75 =>Sub Gerard() qui passe par un tableau pour la recherche?
Car celle-ci doit être plus rapide, non ?

[Dernier conseil avant repas du soir]
Un fichier plus simplifié avec moins de modules et moins d'userform serait plus facile d'usage.
Car avec le fichier actuel, c'est pas évident de naviguer dans le projet VBA.
A toi de voir de que tu en penses et si tu as le temps de simplifier le fichier.
Et si tu devais rejoindre un fichier exemple, prends bien soin de "désactiver" le code dans ThisWorkBook afin que les répondeurs n'aient pas de mauvaises surprises.
[/Dernier conseil]

Dernière piste:
Les interactions entre les nombreuses et longues procédures dans le code de la feuille SuiviAppels ?
 

Staple1600

XLDnaute Barbatruc
Re

Vu la quantité de code VBA à lire, pour le moment , je repasse juste pour un conseil et un exemple
Tu peux alléger ton code et le rendre plus rapide en évitant les Select
Exemple
Ceci
Code:
Sub Effacerdonnées()
    Range("A4:A10000,I4:J10000,N4:X10000,AA4:AH10000,AJ4:AJ10000,AL4:AL10000,AN4:AN10000,AP4:AP10000,AR4:BA20000"). _
        Select
    Range("AR4").Activate
    Selection.ClearContents
    Range("N4").Select
End Sub
peut s'écrire
Code:
Sub Effacerdonnées()
Range("A4:A10000,I4:J10000,N4:X10000,AA4:AH10000,AJ4:AJ10000,AL4:AL10000,AN4:AN10000,AP4:AP10000,AR4:BA20000").ClearContents
End Sub
Bonne fin de soirée.

PS: Ce serait vraiment plus facile avec une PJ simplifiée.
A toi de de voir ;)
 

Staple1600

XLDnaute Barbatruc
Re

=>Usine à gaz
Quand je dis simplifié, c'est dans le cas où le problème est lié à la feuille SuiviAppels et qu'il n'y a pas d'appesl aux Userforms
Normalement une version avec SuiviAppels et les feuilles nécessaires à la recherche et le code VBA impliqué dans la recherche devrait suffire.
(Donc ce serait une version sans les userforms et juste avec les modules nécessaires)
Ainsi on aurait vraiment beaucoup moins de code à lire.
 
Dernière édition:

Discussions similaires

Réponses
8
Affichages
726

Statistiques des forums

Discussions
315 092
Messages
2 116 119
Membres
112 666
dernier inscrit
Coco0505