Private Sub Workbook_Open()
MsgBox "Renseigner la carte de ctrl XXXXX", vbExclamation, "Remplir la carte de ctrl"
If Reponse = vbOK Then
ThisWorkbook.FollowHyperlink "S:\PRODUCTION\2010-2011\01 - Cartes de contrôle\AUMA\VITESSE TAPIS\CDC-2011-96 vitesse_tapis_ed00.xlsm"
End If
End Sub
Sub test4()
Dim fichier1$, Fichier2$, reponse As VbMsgBoxResult
fichier1 = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
Fichier2 = "C:\Users\polux\DeskTop\fichierAouvrir2.xlsm"
If ouvrable(fichier1) Then
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then...
Sub test()
Dim fichier$, OldDate As Date, réponse As VbMsgBoxResult
fichier = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldDate = CDate(Mid(.DateLastAccessed, 1, 10))
End With
If OldDate + 7 > Date Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Sub test()
Dim fichier$, OldWeek As Long, ActualWeek As Long, réponse As VbMsgBoxResult
fichier = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldWeek = ISOWEEK2007(CDate(Mid(.DateLastAccessed, 1, 10)))
ActualWeek = ISOWEEK2007(Date)
End With
If ActualWeek = OldWeek Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Function ISOWEEK2007(dat As Date)
Dim X&
X = CLng(dat)
ISOWEEK2007 = Evaluate("= TRUNC((" & X & "-WEEKDAY(" & X & ",2)+11-DATE(YEAR(" & X & "-WEEKDAY(" & X & " ,2)+4),1,1))/7)")
End Function
Private Sub Workbook_Open()
Dim fichier$, OldWeek As Long, ActualWeek As Long, réponse As VbMsgBoxResult
fichier = "S:\PRODUCTION\2010-2011\01 - Cartes de contrôle\AUMA\VITESSE TAPIS\CDC-2011-96 vitesse_tapis_ed00.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldWeek = ISOWEEK2007(CDate(Mid(.DateLastAccessed, 1, 10)))
ActualWeek = ISOWEEK2007(Date)
End With
If ActualWeek = OldWeek Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl 2011-96", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Function ISOWEEK2007(dat As Date)
Dim X&
X = CLng(dat)
ISOWEEK2007 = Evaluate("= TRUNC((" & X & "-WEEKDAY(" & X & ",2)+11-DATE(YEAR(" & X & "-WEEKDAY(" & X & " ,2)+4),1,1))/7)")
End Function
la bonne blagueMerci beaucoup. par contre j'ai inséré le code dans "Thisworkbook" mais rien ne se passe
Option Explicit
Private Sub Workbook_Open()
Dim Réponse As Variant
Dim CelluleDateModif As Range
Dim DateModif As Date
Dim TakeIt As Boolean
'
Const NomFeuilleDateModif = "Feuil1"
Const AdresseCelluleDateModif = "A1"
'Cellule de la date de dernière modification
Set CelluleDateModif = Me.Worksheets(NomFeuilleDateModif).Range(AdresseCelluleDateModif)
'Si cette cellule contient une date
If IsDate(CelluleDateModif.Value) Then
DateModif = CelluleDateModif.Value
If DateDiff("d", DateModif, Date) >= 7 Then TakeIt = True
'Si cette cellule ne contient pas une date
Else
TakeIt = True
End If
If TakeIt Then
Réponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo + vbQuestion, "Remplir la carte de ctrl")
If Réponse = vbNo Then Exit Sub
ThisWorkbook.FollowHyperlink "S:\PRODUCTION\2010-2011\01 - Cartes de contrôle\AUMA\VITESSE TAPIS\CDC-2011-96 vitesse_tapis_ed00.xlsm"
CelluleDateModif = Date
ThisWorkbook.Save
End If
End Sub
Sub test1()
Dim fichier$, OldDate As Date, réponse As VbMsgBoxResult
fichier = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldDate = CDate(Mid(.DateLastAccessed, 1, 10))
End With
MsgBox "date de dernier accès " & OldDate & vbCrLf & "aujourd'hui " & Date
If OldDate + 7 > Date Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Sub test2()
Dim fichier$, OldWeek As Long, ActualWeek As Long, réponse As VbMsgBoxResult
fichier = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldWeek = ISOWEEK2007(CDate(Mid(.DateLastAccessed, 1, 10)))
ActualWeek = ISOWEEK2007(Date)
End With
MsgBox "semaine precedente " & OldWeek & vbCrLf & "semaine actuelle " & ActualWeek
If ActualWeek = OldWeek Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Function ISOWEEK2007(dat As Date)
Dim X&
X = CLng(dat)
ISOWEEK2007 = Evaluate("= TRUNC((" & X & "-WEEKDAY(" & X & ",2)+11-DATE(YEAR(" & X & "-WEEKDAY(" & X & " ,2)+4),1,1))/7)")
End Function
Sub test3()
Dim fichier$, OldWeek As Long, ActualWeek As Long, réponse As VbMsgBoxResult
fichier = "C:\Users\polux\DeskTop\fichierAouvrir.xlsm"
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
OldWeek = ISOWEEK2007(CDate(Mid(FileDateTime(fichier), 1, 10)))
ActualWeek = ISOWEEK2007(Date)
MsgBox "semaine precedente " & OldWeek & vbCrLf & "semaine actuelle " & ActualWeek
If ActualWeek = OldWeek Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl XXXXX", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Function ISOWEEK2007(dat As Date)
Dim X&
X = CLng(dat)
ISOWEEK2007 = Evaluate("= TRUNC((" & X & "-WEEKDAY(" & X & ",2)+11-DATE(YEAR(" & X & "-WEEKDAY(" & X & " ,2)+4),1,1))/7)")
End Function
tu peux etre plus clair dans tes demandes c'est quoi deux fichiers indépendantsMerci beaucoup patricktoulon. J'ai testé le code avec un fichier qui n'a pas été ouvert cette semaine. ça marche parfaitement.
Ce code peut-il être adapté pour tester 2 fichiers indépendant?
Private Sub Workbook_Open()
Dim fichier$, OldWeek As Long, ActualWeek As Long, réponse As VbMsgBoxResult
fichier = "S:\PRODUCTION\2010-2011\01 - Cartes de contrôle\DISSO\CDC_75064.xlsm"
'fichier 1 = "S:\PRODUCTION\2010-2011\01 - Cartes de contrôle\DISSO\CDC_75000.xlsm"' 'Puis continuer le code ci-dessous'
'récupération de la date du dernier accès (Attention!!!! en string !!!!!!)
With CreateObject("Scripting.FileSystemObject").GetFile(fichier)
OldWeek = ISOWEEK2007(CDate(Mid(.DateLastAccessed, 1, 10)))
ActualWeek = ISOWEEK2007(Date)
End With
If ActualWeek = OldWeek Then Exit Sub ' si cette date + 7 jour est plus grand que la date du jour on sort de la sub
'sinon on a la question avec le message (si on veut ou pas l'ouvrir)
reponse = MsgBox("Renseigner la carte de ctrl 75064", vbYesNo And vbExclamation, "Remplir la carte de ctrl")
If reponse = vbOK Then
ThisWorkbook.FollowHyperlink fichier, , True
End If
End Sub
Function ISOWEEK2007(dat As Date)
Dim X&
X = CLng(dat)
ISOWEEK2007 = Evaluate("= TRUNC((" & X & "-WEEKDAY(" & X & ",2)+11-DATE(YEAR(" & X & "-WEEKDAY(" & X & " ,2)+4),1,1))/7)")
End Function