Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Fichier "FANTÔME"

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 ...


Si éventuellement une solution s'offre à moi je serais ravi
Merci pour votre aide
@Michest94
 
Solution
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()

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
 

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
 

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

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
 

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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…