Saisi date automatique si la cellule rempli et problèmr de 00/01/1900!

Kamalo

XLDnaute Nouveau
Bonjour,

Quand je saisis manuellement dans la colonne K j'obtiens la saisi de la date automatique dans la colonne J à l'aide de la formule { SI(K2="";"";SI(J2<>"";J2;AUJOURDHUI())) } jusque ici tout va bien! mais quand je saisi dans la colonne J à l'aide d'un macro enregistré affecté à un bouton la colonne K donne la date 00/01/1900 au lieu de la date de jours que je cherche.

Je vous remercie d'avance de votre aide!
 
Solution
Merci bcp soan c'est très gentille!
J'espère que c'est ma dernière question :)

J'aimerais bien de créer sur mon classeur deux boutons ENREGISTRER et IMPRIMER pouvez vous me conseiller par un code VBA ou autre solution SVP?

Merci d'avance!

soan

XLDnaute Barbatruc
Inactif
Bonjour Kamalo,

bienvenue sur le site XLD ! :)

ouvre le fichier joint ci-dessous.

* en K2, saisis "x" (par exemple) et appuie sur la touche Entrée ; vu ? ;)

* toujours en K2, appuie sur la touche Suppression ; ok ? 😀

ça marche pareil pour toutes les autres lignes en dessous.

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.



d'autre part, tu es ici sur "Autres discussions / Présentation des nouveaux membres" ; pour ton prochain exo Excel, ce sera mieux que tu postes ta demande sur "Questions / Forum Excel" : tu auras ainsi plus de chances d'obtenir des réponses.​

si tu aimes la musique, je te propose ces liens :

MusiK SZ ; MusiK EY ; MusiK AGI

soan
 

Pièces jointes

  • Exo Kamalo.xlsm
    13.7 KB · Affichages: 8

Kamalo

XLDnaute Nouveau
Bonjour Kamalo,

bienvenue sur le site XLD ! :)

ouvre le fichier joint ci-dessous.

* en K2, saisis "x" (par exemple) et appuie sur la touche Entrée ; vu ? ;)

* toujours en K2, appuie sur la touche Suppression ; ok ? 😀

ça marche pareil pour toutes les autres lignes en dessous.

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.



d'autre part, tu es ici sur "Autres discussions / Présentation des nouveaux membres" ; pour ton prochain exo Excel, ce sera mieux que tu postes ta demande sur "Questions / Forum Excel" : tu auras ainsi plus de chances d'obtenir des réponses.​

si tu aimes la musique, je te propose ces liens :

MusiK SZ ; MusiK EY ; MusiK AGI

soan
Bonjour soan,

Merci pour votre initiative!

Malheureusement c est pas ce que je cherche! merci de voir mon fichier en pièce jointe et vous allez comprendre car le problème a une relation de saisi par un macro enregistré et affecter à un bouton pour le saisi car quand je saisi de cette façon la case affiche 00/01/1900!

Merci d'avance pour votre aide!
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
@Kamalo

malheureusement, ton fichier n'est pas en pièce jointe ! 😭 relis ton post... soit tu as oublié de le joindre, soit il n'est pas passé ; peut-être que sa taille est trop grande ? pas plus de 1 Mo ! suggestion : essaye de zipper ton fichier ; attention : le fichier doit être sans données confidentielles ; s'il y en a, tu dois les remplacer par des données fictives. 🙂

soan
 

Kamalo

XLDnaute Nouveau
@Kamalo

malheureusement, ton fichier n'est pas en pièce jointe ! 😭 relis ton post... soit tu as oublié de le joindre, soit il n'est pas passé ; peut-être que sa taille est trop grande ? pas plus de 1 Mo ! suggestion : essaye de zipper ton fichier ; attention : le fichier doit être sans données confidentielles ; s'il y en a, tu dois les remplacer par des données fictives. 🙂

soan
Merci soan pour votre réponse.

le fichier en pièce jointe.

Merci!
 

Pièces jointes

  • Test1.zip
    218.8 KB · Affichages: 3

soan

XLDnaute Barbatruc
Inactif
Bonjour Kamalo,

ton fichier zip en retour. :)

tu es sur "Feuille2" ; en colonne H, la dernière donnée est en ligne 15, et tu as ces 2 doublons : 8989 et 9090 ; fais Alt F8 ; exécute la 3ème macro SupprimerDoub ➯ y'a plus de plantage, ça a supprimé les 2 doublons sus-mentionnés, et la dernière donnée est maintenant en ligne 13.


va sur "Feuille1" ; en J18, saisis par exemple 250 et clique sur Bouton 1 ; la donnée a été copiée en "Feuille 2" et J18 est effacé : prêt pour une nouvelle saisie ; va sur "Feuille2" pour vérifier ; 250 est en F3 ; et aussi en K2 ; avec devant la date 01/04/21. 😊 et c'est pas un poisson d'avril ! 😁 😜

va sur "Feuille1" ; en J18, saisis par exemple 300 et clique sur Bouton 1 ; la donnée a été copiée en "Feuille 2" et J18 est effacé : prêt pour une nouvelle saisie ; va sur "Feuille2" pour vérifier ; 300 est en F3 ; et aussi en K2 ; avec devant la date 01/04/21. 😊 voici hélas une mauvaise nouvelle :

as-tu remarqué qu'il y a des dièses « # # # # # » en H12 ? si tu élargis la colonne, tu verras la valeur d'erreur #NOMBRE! ; j'ai longtemps bloqué sur ce problème, mais je n'ai pas trouvé de solution ; peut-être sauras-tu quoi faire ? si oui, tant mieux ! sinon, j'espère qu'un autre intervenant pourra régler ça.


pour le code VBA, j'ai supprimé plus d'une dizaine de modules qui étaient vides ; il ne reste plus que 2 modules et je les ai renommés ainsi : M01_Saisie et M02_Entrée ; regarde aussi le module de Feuille1.​

Module M01_Saisie

VB:
Option Explicit

Sub SupprimerDoub()
  Dim cel As Range, lig&: lig = 2: Application.ScreenUpdating = 0
  With Worksheets("Feuille2")
    With .ListObjects("Tableau505")
      With .Sort
        .SortFields.Clear
        .SortFields.Add Range("Tableau505[[Reste]]"): .Apply
      End With
      Do
        Set cel = .Parent.Cells(lig, 8): If cel = "" Then Exit Sub
        If cel = cel.Offset(-1) Then
          .ListRows(lig - 1).Delete: lig = lig - 1
        End If
        lig = lig + 1
      Loop
    End With
  End With
End Sub

Sub Saisie()
  If ActiveSheet.Name <> "Feuille1" Then Exit Sub
  Dim cel As Range: Set cel = [J18]: Application.ScreenUpdating = 0
  Worksheets("Feuille2").Select: Application.Calculation = -4105
  ActiveSheet.ListObjects("Tableau615").ListRows.Add 1
  ActiveSheet.ListObjects("Tableau504").ListRows.Add 2
  [K2] = cel: [F3] = cel: cel.ClearContents
  Worksheets("Feuille1").Select
End Sub

Module M02_Entrée

attention : j'ai juste fait l'indentation, et j'ai pas changé grand chose ; c'est pas au point car j'ai pas bien compris c'que tu veux faire au juste. (en plus j'suis fatigué, alors j'ai pas cherché bien longtemps non plus)

Code:
Sub Entrée()
  Application.Calculation = -4135
  With Worksheets("Data") '<<< A ADAPTER
    With .Range("F2:F40") 'la feuille 2 où l'action se passe
      t = .Value2
      For i = 1 To UBound(t)
        If Application.CountIf(.Cells, t(i, 1)) = 1 Then
          n = n + 1: t(n, 1) = t(i, 1)
        End If
      Next i
      .ClearContents
      If n > 0 Then .Resize(n).Value2 = t
    End With
    .Activate
  End With
  Application.Calculation = -4105
End Sub

Module de Feuille1

VB:
Option Explicit

Private Sub Job()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
  Application.Calculation = -4105
End Sub

Private Sub CommandButton4_Click()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  'Call Annuler
  Application.Calculation = -4105
End Sub

Private Sub CommandButton5_Click()
  Application.Calculation = -4135: Application.ScreenUpdating = 0
  'Call Sortie
  Application.Calculation = -4105
End Sub

Private Sub CommandButton1_Click()
  Call Job: ActiveCell.Select
End Sub

à te lire pour avoir ton avis. 😉

soan
 

Pièces jointes

  • Test1.zip
    172.8 KB · Affichages: 4

Kamalo

XLDnaute Nouveau
Bonjour soan,

merci pour votre réponse!

pour la formule suivante : [Application.Calculation = -4135: Application.ScreenUpdating = 0 ] me rend le calcul du classeur manuel! y a t il une méthode pour que le calcul de classeur soit toujours automatique

Merci à vous encore une fois!
 

soan

XLDnaute Barbatruc
Inactif
Bonjour Kamalo,

-4135 équivaut à xlCalculationManual

-4105 équivaut à xlCalculationAutomatic


essaye ceci, dans le module de Feuil1 :​

VB:
Private Sub Job()
  Application.ScreenUpdating = 0
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
End Sub

soan
 

soan

XLDnaute Barbatruc
Inactif
@Kamalo

essaye d'abord ce que j'ai indiqué dans mon post #8 ci-dessus.

si ça marche : ok ; sinon, essaye ceci (dans le module de Feuil1) :

VB:
Private Sub Job()
  Application.ScreenUpdating = 0: Application.Calculation = -4105
  If [J18] <> "" Then Saisie: Exit Sub
  MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP !", 48, "A VOTRE ATTENTION"
End Sub

Private Sub CommandButton2_Click()
  Call Job: Worksheets("Data").Activate: Application.Run "Entree"
  Worksheets("Tableau chauffeur").Activate
End Sub

soan
 

Kamalo

XLDnaute Nouveau
Bonjour soan,

Dans un classeur j'ai plusieurs boutons mais quand je clique je dois attendre de 6-10 secondes pour vous me corriger les codes suivant pour optimiserl'excution:



Private Sub CommandButton1_Click()
Application.Calculation = -4105: Application.ScreenUpdating = False



If Range("J7") <> "" And Range("J10") <> "" Then
Call Nouveauchauffeur
Else


MsgBox "MERCI DE REMPLIR TOUS LES CHAMPS SVP!", vbExclamation, "A VOTRE ATTENTION"
End If

End Sub

Private Sub CommandButton2_Click()
Application.Calculation = -4105: Application.ScreenUpdating = False


If Range("J18") <> "" Then

Call Saisi



MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP!", vbExclamation, "A VOTRE ATTENTION"
End If



Sheets("Data").Activate

Application.Run ("Entreee")

Sheets("Tableau chauffeur").Activate

Application.Calculation = -4105
End Sub

Private Sub CommandButton3_Click()
Application.Calculation = -4105: Application.ScreenUpdating = 0

If Range("L7") <> "" Or Range("L10") <> "" Then
Call Ntrailer

Else


MsgBox "MERCI DE REMPLIR LE CHAMP VIDE SVP!", vbExclamation, "A VOTRE ATTENTION"
End If

Application.Calculation = -4105
End Sub

Private Sub CommandButton4_Click()
Application.Calculation = -4105: Application.ScreenUpdating = 0

Call Annuler

Application.Calculation = -4105

Private Sub CommandButton5_Click()
Application.Calculation = -4105: Application.ScreenUpdating = 0

Call Sortie


End Sub


Merci d'avance!
 

soan

XLDnaute Barbatruc
Inactif
@Kamalo

dans ton fichier initial, j'avais remarqué une chose que je n'ai pas aimé : dès le départ, le mode de calcul est positionné sur Manuel ! j'ai quand même laissé tel quel, mais ce serait mieux de faire ainsi :

AU DÉPART (à l'ouverture du classeur) : mode de calcul du classeur positionné sur Automatique ; ensuite : a) on n'y touche plus du tout ; OU b) pour chaque sub qui est d'exécution lente à cause de trop nombreuses formules de calcul sur la feuille de calcul : on désactive le calcul automatique AVANT de faire le job, puis on le réactive APRÈS, de cette façon :​

VB:
Sub Essai()
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  'ici, code de la sub qui s'exécute avec en mode de calcul manuel
  Application.Calculation = -4105
End Sub

attention : ce que j'ai écrit plus haut est pour des subs indépendantes ; si la sub A() (qui appelle la sub B() qui appelle la sub C() qui appelle la sub D()) est trop lente à s'exécuter pour la même raison (trop nombreuses formules de calcul sur la feuille de calcul), alors désactiver le mode de calcul automatique puis le réactiver pour A() seulement : c'est inutile de le faire aussi pour B(), C(), et D() :
VB:
Option Explicit

Sub D()
  'code de la sub D : exécuté en mode de calcul manuel
End Sub

Sub C()
  'code de la sub C : exécuté en mode de calcul manuel
  D 'appel de la sub D
End Sub

Sub B()
  'code de la sub B : exécuté en mode de calcul manuel
  C 'appel de la sub C
End Sub

Sub A()
  Application.ScreenUpdating = 0
  Application.Calculation = -4135 'calcul manuel
  B 'appel de la sub B
  Application.Calculation = -4105 'calcul auto.
End Sub


essai d'optimisation de ton code VBA :

VB:
Private Sub AffMsg(chn$)
  MsgBox "MERCI DE REMPLIR " & chn & " SVP !", 48, "À VOTRE ATTENTION"
End Sub

Private Sub CommandButton1_Click()
  If [J7] = "" Or [J10] = "" Then AffMsg "TOUS LES CHAMPS": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Nouveauchauffeur: Application.Calculation = -4105
End Sub

Private Sub CommandButton2_Click()
  If [J18] = "" Then AffMsg "LE CHAMP VIDE": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Saisie: Worksheets("Data").Select: Entrée
  Worksheets("Tableau chauffeur").Select
  Application.Calculation = -4105
End Sub

Private Sub CommandButton3_Click()
  If [L7] = "" And [L10] <> "" Then AffMsg "LE CHAMP VIDE": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Ntrailer: Application.Calculation = -4105
End Sub

Private Sub CommandButton4_Click()
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  Call Annuler: Application.Calculation = -4105
End Sub

Private Sub CommandButton5_Click()
  Application.ScreenUpdating = 0: Application.Calculation = -4105
  Call Sortie: Application.Calculation = -4105
End Sub

note bien que ton code VBA appelle ces 6 subs (non présentes dans ton extrait de code VBA) :

Nouveauchauffeur() ; Ntrailer() ; Saisie() ; Entrée() ; Sortie() ; Annuler()

ce que je vais écrire est par exemple pour ta sub CommandButton3_Click(), qui appelle ta sub Ntrailer() : si Ntrailer() met 5 h à s'exécuter, même en mode de calcul manuel, la sub CommandButton3_Click() que j'ai optimisée mettra quand même au moins 5 h ! 😁 car c'est le temps d'exécution de Ntrailer() + le temps d'exécution de CommandButton3_Click().​

soan
 

Kamalo

XLDnaute Nouveau
😂😂 c'est cool ton exemple!

Merci bcp soan!

Effectivement je voulais reformuler commoandButton3 ! car j'ai deux cases indépendants dans l'exécution et je voudrais le mettre comment suivant:

si la case L7 ET L10 sont vides afficher message merci de remplir les champs
si juste la case L7 rempli appelle Ntrailer1 et rien à faire en plus
Si juste la case L10 rempli appelle Ntrailer2 et rien à faire en plus
Si la case L7 ET L10 remplis appelle Ntrailer1 ET Ntrailer2

en effet je sais pas une bonne idée ou il y a une autre mieux que celle là!

Merci d'avance de me conseiller!
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
@Kamalo

VB:
Private Sub CommandButton3_Click()
  If [L7] = "" And [L10] <> "" Then AffMsg "LES CHAMPS": Exit Sub
  Application.ScreenUpdating = 0: Application.Calculation = -4135
  If [L7] <> "" Then Ntrailer1
  If [L10] <> "" Then Ntrailer2
  Application.Calculation = -4105
End Sub

note bien ceci :

* si L7 est rempli, ça appelle Ntrailer1 (et ensuite, ça n'appellera pas Ntrailer2 si L10 est vide)

* si L10 est rempli, ça appelle Ntrailer2 (et si L7 était vide, ça n'a pas appelé Ntrailer1)

* si L7 et L10 sont remplis, ça appelle Ntrailer1 PUIS Ntrailer2

soan
 

Kamalo

XLDnaute Nouveau
Merci bcp soan c'est très gentille!
J'espère que c'est ma dernière question :)

J'aimerais bien de créer sur mon classeur deux boutons ENREGISTRER et IMPRIMER pouvez vous me conseiller par un code VBA ou autre solution SVP?

Merci d'avance!
 

Discussions similaires

Réponses
7
Affichages
495

Membres actuellement en ligne

Statistiques des forums

Discussions
314 655
Messages
2 111 604
Membres
111 217
dernier inscrit
aladinkabeya2