VB-Condidtion sur la date d'ouverture de fichier

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
TheProdigy

TheProdigy

XLDnaute Impliqué
Bonjour,

Je voudrais savoir comment programmer qu'à l'ouverture du fichier de vérifier si la date d'ouverture est supérieur à une date donnée (31/12/2007) à 00h00 et donc il va falloir supprimer la feuil2

Merci
 
Trier par date Trier par votes
Re : VB-Condidtion sur la date d'ouverture de fichier

re

tu peux aussi par code supprimer les lignes ou les mettre en commentaire maius ça devient compliqué alors qu'un
Code: 
On Error Resume Next
suivi d'un
Code: 
On Error Goto 0
fait aussi bien le travail.

Les puristes ne seront peut être pas d'accord avec moi...

@+
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

Dernière question.

Voilà le fichier que j'ai

Code: 
Private Sub Workbook_Open()
' a l'ouverture du fichier
'comparaison entre V1 et W1
If Sheets("repmada").Range("V1").Value <> Sheets("repmada").Range("W1").Value Then
'si difference changement de V1 et W1
' qui entrainera les changements en D8 C8 D7 C7
For N = 1 To 37
 Sheets("repmada").Range("V" & N) = Sheets("repmada").Range("W" & N)
 Sheets("repmada").Range("X" & N) = Sheets("repmada").Range("Y" & N)
 Sheets("repmca").Range("V" & N) = Sheets("repmca").Range("W" & N)
 Sheets("repmca").Range("X" & N) = Sheets("repmca").Range("Y" & N)
Next N
  Sheets("M_prtf").Range("a1") = Sheets("mcma").Range("i2")
  Sheets("Suivi PLV").Range("a1") = Sheets("mcma").Range("i2")
End If
Dim L As Integer
For L = 2 To Sheets.Count
Sheets(L).Visible = xlVeryHidden
Next L
Feuil1.ScrollArea = "b3"
End Sub

comment & où insérer ton code dans le mien?
Merci
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

re:
Code: 
Private Sub Workbook_Open()
' a l'ouverture du fichier
'comparaison entre V1 et W1
If Sheets("repmada").Range("V1").Value <> Sheets("repmada").Range("W1").Value Then
'si difference changement de V1 et W1
' qui entrainera les changements en D8 C8 D7 C7
For N = 1 To 37
 Sheets("repmada").Range("V" & N) = Sheets("repmada").Range("W" & N)
 Sheets("repmada").Range("X" & N) = Sheets("repmada").Range("Y" & N)
 Sheets("repmca").Range("V" & N) = Sheets("repmca").Range("W" & N)
 Sheets("repmca").Range("X" & N) = Sheets("repmca").Range("Y" & N)
Next N
  Sheets("M_prtf").Range("a1") = Sheets("mcma").Range("i2")
  Sheets("Suivi PLV").Range("a1") = Sheets("mcma").Range("i2")
End If
Dim L As Integer
For L = 2 To Sheets.Count
Sheets(L).Visible = xlVeryHidden
Next L
Feuil1.ScrollArea = "b3"
'J'essaierai ici pour que le code précédent soit exécuté
[B][COLOR=Navy] on error resume next[/COLOR][/B]
If Now > #12/31/2007# Then
   Application.DisplayAlerts = False
   Sheets("Feuil2").Delete
   Application.DisplayAlerts = True
End If
[B][COLOR=Navy] on error goto 0
[/COLOR][/B][COLOR=Navy][COLOR=Black]'la ligne suivante semble inadaptée, elle ferme le classeur et dès que tu
'l'ouvre elle le ferme c'est bien pour faire des blagues mais assez énervant
'au quotidien
'thisworkbook.close true[/COLOR][/COLOR][B][/B] End Sub
merci pour les balises "code"

@+
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

re

tu ne peux pas effacer toutes les feuilles, tu dois en conserver une

dans le code qui suit, j'en ajoute une pour supprimer les autres

Code: 
Sub test()
Dim i As Integer
Sheets.Add , Sheets(Sheets.Count)
Application.DisplayAlerts = False
For i = Sheets.Count - 1 To 1 Step -1
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True

End Sub
NB travaille sur une copie ou n'enregistre pas en fermant.

@+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

Rebonjour
Comment insérer le code suivant
Code: 
Dim i As Integer
Sheets.Add , after:=Sheets(Sheets.Count)
Application.DisplayAlerts = False
For i = Sheets.Count - 1 To 1 Step -1
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True
dans le code suivant
Code: 
Private Sub Workbook_Open()
' a l'ouverture du fichier
'comparaison entre V1 et W1
If Sheets("repmada").Range("V1").Value <> Sheets("repmada").Range("W1").Value Then
'si difference changement de V1 et W1
' qui entrainera les changements en D8 C8 D7 C7
For N = 1 To 37
 Sheets("repmada").Range("V" & N) = Sheets("repmada").Range("W" & N)
 Sheets("repmada").Range("X" & N) = Sheets("repmada").Range("Y" & N)
 Sheets("repmca").Range("V" & N) = Sheets("repmca").Range("W" & N)
 Sheets("repmca").Range("X" & N) = Sheets("repmca").Range("Y" & N)
Next N
  Sheets("M_prtf").Range("a1") = Sheets("mca").Range("i2")
  Sheets("Suivi PLV").Range("a1") = Sheets("mca").Range("i2")
End If
Dim L As Integer
For L = 2 To Sheets.Count
Sheets(L).Visible = xlVeryHidden
Next L
Feuil1.ScrollArea = "b3"
'J'essaierai ici pour que le code précédent soit exécuté
 on error resume next
If Now > #12/31/2007# Then
   Application.DisplayAlerts = False
   Sheets("Feuil2").Delete
   Application.DisplayAlerts = True
End If
 on error goto 0
'la ligne suivante semble inadaptée, elle ferme le classeur et dès que tu
'l'ouvre elle le ferme c'est bien pour faire des blagues mais assez énervant
'au quotidien
'thisworkbook.close true End Sub
Merci
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

bonsoir,

difficile de répondre à ta question.
que veux tu faire exactement?

Explication succincte des codes
Code: 
Dim i As Integer
[COLOR=DarkGreen] 'Ajout d'une feuille en dernier[/COLOR]
'Sheets.Add , Sheets(Sheets.Count)
[COLOR=DarkGreen] 'non affichage des messages d'alerte[/COLOR]
'Application.DisplayAlerts = False
[COLOR=DarkGreen] 'boucle sur les feuilles de l'avant dernière à la première[/COLOR]
'For i = Sheets.Count - 1 To 1 Step -1

[COLOR=DarkGreen]Ajout d'une feuille en premier[/COLOR]
Sheets.Add Sheets(1)
[COLOR=DarkGreen] 'non affichage des messages d'alerte
[/COLOR]Application.DisplayAlerts = False
[COLOR=DarkGreen] 'boucle sur les feuilles de [/COLOR][COLOR=DarkGreen]la seconde à la [/COLOR][COLOR=DarkGreen]dernière[/COLOR]
For i = 2 To Sheets.Count
    [COLOR=DarkGreen]'Suppression de chaque feuille de la boucle[/COLOR]
    Sheets(i).Delete
Next i
[COLOR=DarkGreen] 'affichage des messages d'alerte[/COLOR]
Application.DisplayAlerts = True
Code: 
Private Sub Workbook_Open()
' à l'ouverture du fichier
'comparaison entre V1 et W1
If Sheets("repmada").Range("V1").Value <> Sheets("repmada").Range("W1").Value Then
  '###################
  'si différence changement de V1 et W1
  ' qui entraînera les changements en D8 C8 D7 C7
  '###################
  [COLOR=DarkGreen]'Boucle sur les cellules V1:V37 et X1:X37 des feuilles repmada et repmca 1 à 37[/COLOR]
  For N = 1 To 37
    Sheets("repmada").Range("V" & N) = Sheets("repmada").Range("W" & N)
    Sheets("repmada").Range("X" & N) = Sheets("repmada").Range("Y" & N)
    Sheets("repmca").Range("V" & N) = Sheets("repmca").Range("W" & N)
    Sheets("repmca").Range("X" & N) = Sheets("repmca").Range("Y" & N)
  Next N

  '' solution plus rapide que la boucle
  'Dim tablo1 As Variant
  ''remplissage du tableau avec les valeurs de la plage ...
  'tablo1 = [repmada!W1:W37]
  ''remplissage de la plage avec les valeurs du tableau
  '[repmada!V1:V37] = tablo1
  'tablo1 = [repmada!Y1:Y37]: [repmada!X1:X37] = tablo1
  'tablo1 = [repmca!W1:W37]: [repmca!V1:V37] = tablo1
  'tablo1 = [repmca!Y1:Y37]: [repmca!X1:X37] = tablo1

  [COLOR=DarkGreen]'changement des valeurs[/COLOR]
  Sheets("M_prtf").Range("a1") = Sheets("mca").Range("i2")
  Sheets("Suivi PLV").Range("a1") = Sheets("mca").Range("i2")
End If

Dim L As Integer
[COLOR=DarkGreen] boucle de la seconde feuille à la dernière[/COLOR]
For L = 2 To Sheets.Count
  [COLOR=DarkGreen]'masquage "VeryHidden" des feuilles[/COLOR]
  Sheets(L).Visible = xlVeryHidden
Next L

[COLOR=DarkGreen] 'définition de la zone de défilement de la feuille dont le nom de code est Feuil1[/COLOR]
Feuil1.ScrollArea = "b3"

[COLOR=DarkGreen] 'Gestion d'erreur[/COLOR]
on error resume next
' If Now > #12/31/2007# Then
[COLOR=DarkGreen] 'Si la date du jour est postérieure au 31/12/2007 alors[/COLOR]
If Date > #12/31/2007# Then
   [COLOR=DarkGreen]'non affichage des messages d'alerte[/COLOR]
  Application.DisplayAlerts = False
  [COLOR=DarkGreen]' suppression de la feuille "Feuil2"[/COLOR]
  '[COLOR=Red]à la ligne suivante, tu as une erreur: il est impossible de supprimer une feuille masquée, et je ne sais pas si la Feuil2 existe[/COLOR]
  Sheets("Feuil2").Delete
  [COLOR=DarkGreen]'affichage des messages d'alerte[/COLOR]
  Application.DisplayAlerts = True
End If
[COLOR=DarkGreen] 'Invalidation du gestionnaire d'erreur[/COLOR]
on error goto 0
'la ligne suivante semble inadaptée, elle ferme le classeur et dès que tu
'l'ouvre elle le ferme c'est bien pour faire des blagues mais assez énervant
'au quotidien
'thisworkbook.close true 
End Sub
cordialement
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

Ah oui je comprends maintenant qu'il est impossible de supprimer une feuille masquée.

Je te remercie infiniment pour tes explications exhaustives.

Ce que je voudrais faire c'est au lieu de supprimer la feuille2 qui n'existe pas (c'était juste pour essayer le code). J'afficherai toutes les feuilles et ensuite les supprimer ensuite fermer le classeur automatiquement.

Merci infiment pour ton implcation dans les explication ce forum est devenu mon prof 🙂
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

bonsoir,

plutôt que de supprimer et enregistrer un classeur vide, tu peux utiliser cette macro qui supprime définitivement le classeur du disque dur
Code: 
Sub Suicide()
Dim Fname As String
Dim i As Integer
   With ThisWorkbook
       'enregistrement
       .Save
       'suppression de la liste des fichiers récents
       For i = 1 To Application.RecentFiles.Count
           If Application.RecentFiles(i).Path = .FullName Then _
               Application.RecentFiles(i).Delete: Exit For
       Next i
       'passage en lecture seule
       .ChangeFileAccess Mode:=xlReadOnly
       'suppression du fichier
       Kill .FullName
       'fermeture du classeur
       .Close
   End With
End Sub
cordialement

EDIT pour le chemin du Bureau, si tu cherches toujours, il y a plus simple que donné précédemment. Merci Silkyroad
Code: 
Sub CheminBureau()
'testé avec Excel 2002 & WinXp, avec Excel 2007 & Vista
Const Cible = &H0 ' &H5 Mes Documents
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
 
MsgBox objFolderItem.Path
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

wao!
Super cool Fred
Génial à vrai dire il y a des génies dans ce forum
Merci encore Fred j'apprends de plus en plus grâce à votre expertise.
Qu'est ce que tu me recommande pour apprendre et arriver à 25% ton niveau?
Tes explications succintes sont trés pertinentes Sachant que je suis trés débutant.
Cordialement.
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

Bonjour,

Je voudrais bien revenir sur ma discussion. Ton code Fred me donne erreur lors de l'ouverture je pense que c'est dû à l'affichage du message "Mettre à jour les données?". Le code en question fonctionne bien quand le fichier ne contient pas de liaisons à mettre à jour mais si c'est le cas il signale erreur quand je mets à jour.
Est-ce qu'on pourrait pas par exemple ajouter la condition de ne pas demander la mise à jour des liaisons à l'ouverture aprés la date mentionnée?
et exécuter directement le code. Sinon si vous avez d'autres alternatives!

Merci
 
Vote positif 0 Vote négatif
Re : VB-Condidtion sur la date d'ouverture de fichier

J'ai oublié de vous rappeler le code
Code: 
Private Sub Workbook_Open()
If Sheets("repmada").Range("V1").Value <> Sheets("repmada").Range("W1").Value Then
  Dim tablo1 As Variant
  tablo1 = [repmada!W1:W37]
  tablo1 = [repmada!Y1:Y37]: [repmada!X1:X37] = tablo1
  tablo1 = [repmca!W1:W37]: [repmca!V1:V37] = tablo1
  tablo1 = [repmca!Y1:Y37]: [repmca!X1:X37] = tablo1
    
  Sheets("M_prtf").Range("a1") = Sheets("mca").Range("i2")
  Sheets("Suivi PLV").Range("a1") = Sheets("mca").Range("i2")
End If

Dim L As Integer
For L = 2 To Sheets.Count
  Sheets(L).Visible = xlVeryHidden
Next L

 Feuil1.ScrollArea = "b3"
On Error Resume Next
If Date > #12/20/2007# Then
     Application.DisplayAlerts = False
  Call Suicide
  Application.DisplayAlerts = True
End If
 On Error GoTo 0
End Sub
Merci
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

anthoYS
  • Question Question
XL 2019 [VB] Organisation et gestion du ménage et de l'entretien global (à améliorer)... Comment procéder ?
Réponses
13
Affichages
516
anthoYS
anthoYS
L
  • Résolu(e)
Microsoft 365 solde mini maxi et moyen quotidien
2
Réponses
24
Affichages
687
Laurent78
L
M
  • Question Question
Microsoft 365 Automatisation de la date et des lignes sur Feuil1
Réponses
5
Affichages
739
Musbek
M
N
  • Question Question
Microsoft 365 Calcul de prix moyen pondéré de recettes
2
Réponses
15
Affichages
832
Nino63
N
B
  • Question Question
Microsoft 365 Remplacer #Ref! par 0
Réponses
12
Affichages
520
BSF
B
nka
  • Résolu(e)
XL 2021 Gestion des heures sur Excel
Réponses
2
Affichages
431
nka
nka
A
  • Résolu(e)
Microsoft 365 Formule : identifier si une date est dépassée par rapport à une autre date (sur TCD)
Réponses
2
Affichages
491
Alstroemeria
A
M
  • Question Question
Microsoft 365 Décaler une date au premier jour ouvré suivant si le résultat tombe un samedi, dimanche ou un jours férié
Réponses
14
Affichages
810
mapomme
mapomme
pascal21
  • Question Question
XL 2016 intégrer une macro sur les nouvelles feuilles crées
Réponses
6
Affichages
223
pascal21
pascal21
nat54
  • Résolu(e)
Microsoft 365 Découper un fichier en plusieurs fichiers
2
Réponses
24
Affichages
822
nat54
nat54
Z
  • Question Question
XL 2010 Empêcher la demande de sauvegarde pour un fichier non modifié utilisant un Complément Xlam
5 6 7
Réponses
96
Affichages
3 K
Zorgloub
Z
D
  • Résolu(e)
Microsoft 365 carte choroplèthe et conditionner la couleur selon une liste déroulante de choix
Réponses
8
Affichages
778
Daniel200666
D
jeanmi
  • Résolu(e)
XL 2010 Extraction de la valeur de l’heure d’une date
2
Réponses
15
Affichages
1 K
jeanmi
jeanmi
O
  • Question Question
Autres recopie de cellules selon la date
Réponses
3
Affichages
366
olivier Clech
O
R1-
  • Résolu(e)
Microsoft 365 Problème de formatage de dates au format EUR
Réponses
2
Affichages
423
R1-
R1-
O
  • Question Question
XL 2019 Mise a jour prix en fonction de la date
Réponses
8
Affichages
505
Ocbpatate
O
Phil Du59
  • Question Question
XL 2019 Ajout d'un bouton DELETE sur mon USF
2 3
Réponses
43
Affichages
2 K
Phil Du59
Phil Du59
R
  • Résolu(e)
Microsoft 365 Fichier xls suivi délai d'affaires
2 3
Réponses
42
Affichages
2 K
Roran2024
R
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
1 K
Dégé59
D
Y
  • Résolu(e)
XL 2019 Compter le nb de Fichier dans un dossier afin de créer une nouvelle version
Réponses
2
Affichages
542
youguybass
Y
Retour