Microsoft 365 Fichier "FANTÔME"

Michest94

Michest94

XLDnaute Occasionnel
Bonjour,🙂

Je travail dans un service de maintenance et j'ai récupéré un fichier se présentant comme un cahier de maintenance qui renvoie diverses infos technique de sites d'interventions. Celui-ci est très intéressant pour le service et peut se partager facilement mais ...

La personne qui travaillait sur ce fichier n'est plus la , elle a laissé le code admin pour accès fichier et vba (ADMIN1967) est il possible à partir de ce fichier d'apporter des améliorations car dès que j'essai une opération il se met en sauvegarde et se ferme ...

Page de téléchargement du fichier partagé

mon-partage.fr mon-partage.fr

Si éventuellement une solution s'offre à moi je serais ravi
Merci pour votre aide
@Michest94
 
Solution
vgendron
Sans etre pro, le code n'aide pas à la compréhension vu que la plupart du temps, les feuilles sont masquées, protégées, et la barre de formule désactivée. par pratique pour s'y retrouver..
c'es pour ca que j'ai ajouté une macro que tu peux utiliser pour tout voir et ainsi suivre plus facilemenent le déroulement du code
dans le module 2: Sub Deprotege()
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
re
voir Code Workbook_Open
VB: 
Private Sub Workbook_Open()
nocompt = True
'timerstart = TimeValue(Now) 'j'ai isolé cà
'    lookinstatusbar 'et cà
Application.ScreenUpdating = False
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1

Feuil1.ComboBox1.Text = "Sélectionner site >>"
Feuil1.ComboBox2.Text = "Sélectionner site >>"

' Masquage lignes/colonnes et barre formule
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

' DeMasquage des onglets
ActiveWindow.DisplayWorkbookTabs = True

Sheets("Login").Protect "ADMIN1967"
Sheets("Login").Visible = True ' seul Login sera visible

'On Error Resume Next
'Masquage des feuilles sauf Login qui est la 1ere feuille et protection des feuilles 2 à 7 uniquement
For n = 2 To Sheets.Count
Sheets(n).Visible = False
'If n < 8 Then Sheets(n).Protect "ADMIN1967"
If n < 9 Then Sheets(n).Protect "ADMIN1967"
Next 
 ' on vide la cellule nom
    Worksheets("Login").Range("D35") = ""
 ' on vide le textbox et on remet les ***
    Worksheets("Login").TextBox_mdp = ""
    Worksheets("Login").TextBox_mdp.PasswordChar = "*" 
If Sheets("ACCUEIL").ProtectContents = False Then Sheets("ACCUEIL").Protect "ADMIN1967"
Sheets("ACCUEIL").EnableSelection = xlUnlockedCells
'Gestion compteur pour date et Login
Dim Auj&, ligne%
  Auj = Date 'Auj = date du jour
    If Application.CountIf(Range("Compteur[Dates]"), Auj) = 0 Then 'si date du jour n'existe pas dans colonne dates
        Sheets("Cpt").ListObjects("Compteur").ListRows.Add 'ajouter une ligne
        ligne = Sheets("Cpt").Range("Compteur").Rows.Count 'ligne = nombre de lignes du tableau (après l'ajout)
       Sheets("Cpt").Range("Compteur[Dates]")(ligne) = Date  'dernière cellule de Dates = date du jour
    Else
        ligne = Application.Match(Auj, Sheets("Cpt").Range("Compteur[Dates]"), 0) 'sinon, ligne = position de correspondance dans Dates
    End If
        Sheets("Cpt").Range("Compteur[Login]")(ligne) = Sheets("Cpt").Range("Compteur[Login]")(ligne) + 1
        Sheets("Cpt").Range("K1") = ligne 'place le n° ligne de la date en J1
End Sub
jean marie
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
cette procédure semble fermée le Fichier , je l'ai donc désactivé !
VB: 
Sub lookinstatusbar() '
    Dim heure1, x, y
   On Error Resume Next
   If Not rupturcycle Then
      heure1 = TimeValue(Now)
        x = Application.Text(heure1 - timerstart, "[hh]:mm:ss")
        minute_max = TimeValue(durée_max)
        y = TimeValue(Application.Text(minute_max - TimeValue(x), "[hh]:mm:ss"))
        If TimeValue(y) < TimeValue("00:01:01") Then mess = "  Attention fermeture dans moins d'une minute !!!": Beep Else mess = "  il reste plus que :  "
        If y = 0 Then fermeture: Exit Sub
        DoEvents
        Application.StatusBar = "------heure d'ouverture fichier : " & timerstart & "    temps passé:  " & x & mess & y
        Application.OnTime Now + 0.00005, "ThisWorkbook.lookinstatusbar"
    End If
End Sub
et plus de fermeture(reste les erreurs a traiter)
jean marie
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Hello :
pour info :
1625583238320.png

lionel,
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Alors @ChTi160 Toutes mes excuses
effectivement cette macro provoque la sortie
la manip que je viens de faire:
je passe en mode "Mode Création" et automatiquement la proc "lookinstatusbar" est lancée
cette procédure est semble t il executée toutes les 4 s (avec le doevents)
le fait de passer en mode création, la valeur y reste vide ce qui provoque la sortie....

j'ai essayé de rajouté une condition sur le y
VB: 
Sub lookinstatusbar()

Dim heure1, x, y
   On Error Resume Next
   If Not rupturcycle Then
        heure1 = TimeValue(Now)
        x = Application.Text(heure1 - timerstart, "[hh]:mm:ss")
        minute_max = TimeValue(durée_max)
        y = TimeValue(Application.Text(minute_max - TimeValue(x), "[hh]:mm:ss"))
        If TimeValue(y) < TimeValue("00:01:01") Then mess = "  Attention fermeture dans moins d'une minute !!!": Beep Else mess = "  il reste plus que :  "
        If y <> "" Then
            If y = 0 Then
                fermeture
                Exit Sub
            End If
        End If
        DoEvents
        Application.StatusBar = "------heure d'ouverture fichier : " & timerstart & "    temps passé:  " & x & mess & y
        Application.OnTime Now + 0.00005, "ThisWorkbook.lookinstatusbar"
    End If
End Sub

il n'y a plus de fermeture.... mais.. toutes les 4s, on entend le bip windows...

donc
pour aller bricoler dans le VBA, il faut d'abord commenter cette macro
et ne pas oublier de la décommenter en sortant..

en attendant: voici le fichier avec quelques corrections:
1) toutes les range nommées en erreur de ref ont été supprimées
2) j'ai rajouté une range nommée (DataBase)
3) j'ai modifié la formule en C3 des feuilles "Intervenant" et "Prestataires" pour avoir le bon numéro
4) j'ai modifié le chargement des Combobox1 et 2 de la feuille Acceuil
j'ai supprimé la propriété ListFillRange qui ne prenait pas en compte l'ajout de lignes dans la base justement
les combo sont donc remplis à chaque fois que la feuille Acceuil est activée

Edit:

pour éviter le Bip toutes les 4s, j'ai modifié comme suit
VB: 
Sub lookinstatusbar()

Dim heure1, x, y
   On Error Resume Next
   If Not rupturcycle Then
        heure1 = TimeValue(Now)
        x = Application.Text(heure1 - timerstart, "[hh]:mm:ss")
        minute_max = TimeValue(durée_max)
        y = TimeValue(Application.Text(minute_max - TimeValue(x), "[hh]:mm:ss"))
        If y = "" Then y = "00:01:01"
        If TimeValue(y) < TimeValue("00:01:01") Then mess = "  Attention fermeture dans moins d'une minute !!!": Beep Else mess = "  il reste plus que :  "
        If y <> "" Then
            If y = 0 Then
                fermeture
                Exit Sub
            End If
        End If
        DoEvents
        Application.StatusBar = "------heure d'ouverture fichier : " & timerstart & "    temps passé:  " & x & mess & y
        Application.OnTime Now + 0.00005, "ThisWorkbook.lookinstatusbar"
    End If
End Sub

ca veut dire qu'une fois qu'on est passé en mode création, le compteur de temps n'est plus mis à jour: il faut fermer et rouvrir le fichier
 

Pièces jointes

  • CahierMAINTENANCE V3.0. FORUM .xlsm
    764.6 KB · Affichages: 11
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
macro "Documentatio" : elle sert à quoi ??
telle qu'elle est écrite elle ne fera rien puisque le end sub est juste après le sub documentation()

à mon avis, il faut corriger comme ca.. si ca sert vraiment à quelque chose puisque je n'ai vu nulle part qu'on y faisait appel

VB: 
Sub Documentations()

'
' Documentations Macro
'
Sheets("Documentations").Visible = True

On Error GoTo erreur
    Sheets("Documentations").Select
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 8
    Range("I5").ClearContents
    Range("H7").ClearContents
erreur:
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
et je n'avais pas précisé, mais j'ai aussi corrigé la fonction tri_base


VB: 
Sub TRI_Base()
'
Application.EnableEvents = False
' Tri base de données
With ActiveSheet
    Fin = .Range("DataBase").Rows.Count + 3
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("A5:A" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange ActiveSheet.Range("DataBase")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

Michest94
  • Question
Microsoft 365 Récupération d'un fichier obselète
3 4 5
Réponses
73
Affichages
4 K
Michest94
Michest94

Membres actuellement en ligne

16 membres et 337 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 234
Messages
2 086 475
Membres
103 226
dernier inscrit
smail12