Microsoft 365 Fichier "FANTÔME"

Michest94 · 6 Juillet 2021

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

Si éventuellement une solution s'offre à moi je serais ravi
Merci pour votre aide
@Michest94

ChTi160 · 6 Juillet 2021

Le VBA c'est le même mot de pass ADMIN1967
les feuille c'est le même etc etc me semble t'il !
jean marie

Etoto · 6 Juillet 2021

ChTi160 à dit:
Le VBA c'est le même mot de pass ADMIN1967
les feuille c'est le même etc etc me semble t'il !

Alors ça c'est cool au moins.

Michest94 · 6 Juillet 2021

j'ai rien d'autre comme mdp

Michest94 · 6 Juillet 2021

oui acces et vba code identique

ChTi160 · 6 Juillet 2021

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 · 6 Juillet 2021

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

Usine à gaz · 6 Juillet 2021

Hello :
pour info :

lionel,

jcf6464 · 6 Juillet 2021

Bonjour Michest94 et vous tous le forum,

Avec les infos de jean marie cela fonctionne mieux

a+ jcf

vgendron · 6 Juillet 2021

Cette macro "lookinstatusbar" n'est sans doute pas la source du pb puisqu'elle ferme le fichier au bout de 2h..

ChTi160 · 6 Juillet 2021

Re
Il m'a semblé que ..... Lol
Mais plus de problème après avoir désactivé cette procédure .
Sauf erreurs normales liens etc etc
Jean marie

vgendron · 6 Juillet 2021

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

Michest94 · 6 Juillet 2021

Merci pour tout ces retours je vais regarder et faire mes essais
encore merci pour votre aide ... 👍

vgendron · 6 Juillet 2021

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

Michest94 · 6 Juillet 2021

cela ne sert à rien

vgendron · 6 Juillet 2021

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

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Fichier "FANTÔME"

Michest94

XLDnaute Occasionnel

Page de téléchargement du fichier partagé

vgendron

ChTi160

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

Michest94

XLDnaute Occasionnel

Michest94

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

jcf6464

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Pièces jointes

Michest94

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

Michest94

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée