Bouton "Annuler" d'une InputBox
Bonjour, et merci de me lire !
Je me casse les dents depuis quelques jours sur le dilemme suivant :
Dans le code qui suit, pour que la recherche de date fonctionne, il faut que la variable DC (Date Cherchée) soit déclarée "As Date".
Mais pour que le contrôle "Annuler" de l'inputBox fonctionne (If DC = "" Then Exit Sub), il faut que la variable DC soit déclarée "As String", ce qui est normal puisque le bouton "Annuler" renvoie une chaine de caractère vide.
Comment concilier ces deux exigences. Merci de votre aide.
Sub VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"
'0-Variables
Dim DC As Date 'Date Cherchée
Dim CellDC As Range 'Cellule contenant la Date Cherchée
'1-Recherche la cellule contenant la Date Cherchée
DC = InputBox("Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023")
If DC = "" Then 'CE CONTROLE NE FONCTIONNE PAS - A ETUDIER
Exit Sub
End If
Set CellDC = Range("D:D").Find(DC, LookAt:=xlWhole)
If CellDC Is Nothing Then
MsgBox ("Désolé ! La date cherchée " & DC & " est introuvable !")
Exit Sub
End If
'2-Sélectionne la cellule contenant la Date Cherchée
Range(CellDC.Address).Select
End Sub 'VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"Bonjour,
Il me semble qu'il te faut transformer ta date DC en String avant de l'utiliser dans ton contrôle "Annuler
Dim DCSt as String
DCSt = Clng(DC)
If DCSt = "" ....etc
je crois que cela devrait convenir
Bonne journée
Merci Jacky,
Désolé, mais j'ai toujours le défaut "Incompatibilité de type".
Pas grave, je continue de chercher, et de scruter d'éventuelles autres réponses.
Bonjour,
Peut-être comme ceci :
Dim iVar As Variant, madate As Date
iVar = InputBox("saisir une date")
If StrPtr(iVar) = 0 Then
MsgBox "Vous avez annulé", vbCritical + vbOKOnly, "Annulation utilisateur"
Else
madate = CDate(iVar)
MsgBox madate
End IfBonjour,
Attention, le retour des InputBox n'est pas typé par défaut, il s'agit d'un variant. Afin d'avoir un code robuste vous devriez, comme suggéré par Jacky, définir l'entrée utilisateur comme une String, puis ensuite controler sa validité en la convertissant.
Pour cela, écrivez plutot :
Dim DC As String
DC = Application.InputBox(prompt := "Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023", type := 2)Ensuite en exécutant le code pas à pas vous remarquerez que lors du clic sur Cancel, DC prend de force la valeur "False".
Il faut donc remplacer votre test par
If DC = "False" Then Exit SubPour terminer, concernant la conversion de String en Date, il existe 2 méthodes :
La conversion "Forcée" en utilisant Cdate(DC), qui récupère la Date + l'heure si renseignée (jj/mm/aaaa hh:mm:ss) de l'entrée, ou la fonction DateValue(DC) qui ne récupère que la Date.
Dans votre cas les 2 sont égales :
Voilà, et si vous voulez faire un code très propre, entourez vos tests d'une gestion d'erreurs en cas d'entrée utilisateur incorrecte (par exemple "abc"), sur lesquelles les conversion CDate et DateValue vont planter.
Une manière élégante de gérer cela est de remplacer
If DC = "False" Then Exit SubPar
wrongInput:
DC = Application.InputBox(prompt:="Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023", Type:=2)
On Error GoTo wrongInput
If DateValue(DC) Then
' mettre les actions à effectuer ici
End If
'wrongInput: ' ici pour quitter la macro
End SubSi vous préférez, vous pouvez mettre le label wrongInput avant le End Sub afin de quitter la macro au lieu de la relancer lors d'une entrée incorrecte.
Bonjour
essayez votre code comme ceci :
Sub VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"
'0-Variables
Dim DC As String 'Date Cherchée
Dim CellDC As Range 'Cellule contenant la Date Cherchée
'1-Recherche la cellule contenant la Date Cherchée
On Error Resume Next
DC = InputBox("Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023")
If DC = vbNullString Then Exit Sub
On Error GoTo 0
Set CellDC = Range("D:D").Find(CDate(DC), LookAt:=xlWhole)
If CellDC Is Nothing Then
MsgBox ("Désolé ! La date cherchée " & DC & " est introuvable !")
Exit Sub
End If
'2-Sélectionne la cellule contenant la Date Cherchée
Range(CellDC.Address).Select
End Sub 'VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"Cordialement
EDIT : oups Saboh12617, je n'avais pas vu votre réponse. Bon cela va dans le même sens de toute façon
Merci à tous,
Il me faut un peu de temps pour tester tout cela. Je reviens vers vous après.
Bonne après-midi !
Pour être "safe" sans gestion d'erreur :
Dim iVar As Variant, madate As Date
iVar = InputBox("saisir une date")
If StrPtr(iVar) = 0 Then
MsgBox "Vous avez annulé", vbCritical + vbOKOnly, "Annulation utilisateur"
Else
If IsDate(iVar) Then
madate = CDate(iVar)
MsgBox madate
Else
MsgBox "date invalide"
End If
End IfDe nouveau moi,
Une petite remarque de taille : quand je teste la valeur de DCSt je demandais si elle était vide alors que si la date n'existe pas DCSt vaut alors 0
Donc remplace, sauf nouvelle erreur de ma part
If DCSt = ""
Par
If DCSt = "0"
Bonjour à tous
J'y vais aussi de ma p'tite version...
J'ai recyclé une ancienne fonction personnalisée que j'avais faite : TextDateFrOK(xDateText)
- xDateText est une chaine de caractères censée représenter une date de type français (j/m/aa ou j/m/aaaa)
- TextDateFrOK retourne une date au format Excel si xDateText représente une date correcte. Dans le cas contraire, TextDateFrOK retourne la valeur d'erreur #N/A
rem 1 : les séparateurs pour distinguer le jour, le mois, l'année au sein de la date texte peuvent être égal aux signes guillemet, slash, astérisque, signe moins, signe plus, point, virgule, point-virgule ou espace. Les séparateurs sont soit un seul de ces caractères soit une combinaison de ces caractères.
rem 2 : la fonction TextDateFrOK est aussi utilisable sur une feuille de calcul
La fonction contourne les inconvénients de Cdate() et DateValue() qui peuvent renvoyer une date incorrecte (voir sub test dans le classeur).
Tous les codes sont dans module1.
Le code de VersDate() :
Sub VersDate() 'Pour aller vers une date spécifiée dans l'onglet "Actif-Passif-Encours"
Dim DC, laDate, ligne As Long, CellDC As Range
With Sheets("Actif-Passif-Encours")
DC = InputBox("Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023")
If DC = "" Then MsgBox "La date saisie est vide => annulation.", vbCritical: Exit Sub
laDate = TextDateFrOK(DC)
If IsError(laDate) Then MsgBox DC & " est une date incorrecte.", vbCritical: Exit Sub
ligne = Application.IfError(Application.Match(CLng(laDate), .Columns("d:d"), 0), 0)
If ligne > 0 Then .Cells(ligne, "d").Select Else MsgBox ("Désolé ! La date cherchée " & DC & " est introuvable !"), vbCritical
End With
End SubLe code de la fonction personnalisée TextDateFrOK() :
Function TextDateFrOK(ByVal xDateText As String)
' retourne la date (format date excel) si xDateText représente une date correcte sinon renvoie la valeur d'erreur #N/A
Const separateurs = "/*-+. ,;" ' indique les séparateurs possibles au sein de la date (à adapter)
Dim i&, tail&, s1$, s2$, yj, ym, ya
xDateText = Trim(xDateText)
For i = 1 To Len(separateurs): xDateText = Replace(xDateText, Mid(separateurs, i, 1), "/"): Next
Do: tail = Len(xDateText): xDateText = Replace(xDateText, "//", "/"): Loop Until tail = Len(xDateText)
TextDateFrOK = CVErr(xlErrNA)
On Error Resume Next
yj = Left(xDateText, InStr(xDateText, "/") - 1): ya = Mid(xDateText, InStrRev(xDateText, "/") + 1)
ym = Mid(xDateText, InStr(xDateText, "/") + 1): ym = Left(ym, InStr(ym, "/") - 1)
s1 = Format(DateSerial(ya, ym, yj), "ddmmyyyy"): s2 = Format(DateValue(xDateText), "ddmmyyyy")
If s1 = s2 Then TextDateFrOK = DateSerial(ya, ym, yj)
On Error GoTo 0
End FunctionLe code de la procédure Test :
Sub TEST()
Const madate = "29/2/23"
Dim s, res
s = """" & madate & """"
res = "Cdate( " & s & " ) devient la date " & CDate(madate) & vbLf & vbLf
res = res & "DateValue( " & s & " ) devient la date " & DateValue(madate)
MsgBox res
End SubRe Bonjour,
Voilà la version finale de mon code qui fonctionne parfaitement maintenant grâce à tous vos conseils. Je l'ai bien sûr adapté en fonction de mes (mauvaises) habitudes (Désignation des variables, commentaires pour dépannage, etc.)
Je garde bien entendu au chaud toutes vos lumières pour un usage ultérieur, grâce à la rubrique "Mes participations".
Un grand merci à tous. En vous souhaitant une bonne soirée.
Sub VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"
'0-Variables (et légende)
Dim DCStr As String 'Date Cherchée au format String
Dim DCDat As Date 'Date Cherchée au Format Date
Dim CellDCDat As Range 'Cellule contenant la Date Cherchée au format Date
'1-Demande la date cherchée ou annule cette demande
DCStr = InputBox("Date cherchée ? :" & vbCrLf & vbCrLf & "Au format J/M/AA ou JJ/MM/AAAA" & vbCrLf & "Exemple : 3/2/23 ou 03/02/2023", "Actif-Passif-Encours")
If StrPtr(DCStr) = 0 Then
MsgBox "Demande annulée", 64, "Actif-Passif-Encours"
Exit Sub
End If
'2-Contrôle cette date (Format et valeur) et la convertit (Format "String" DCStr vers format "Date" DCDat)
If IsDate(DCStr) Then
DCDat = CDate(DCStr)
Else
MsgBox "La date est invalide", 64, "Actif-Passif-Encours"
Exit Sub
End If
'3-Recherche la cellule contenant la Date Cherchée
Set CellDCDat = Range("D:D").Find(DCDat, LookAt:=xlWhole)
If CellDCDat Is Nothing Then
MsgBox "La date cherchée " & DCDat & " n'existe pas !", 16, "Actif-Passif-Encours"
Exit Sub
End If
'4-Sélectionne la cellule contenant la Date Cherchée (La première si il y en a plusieurs)
Range(CellDCDat.Address).Select
End Sub 'VersDate() 'Pour aller vers une date spécifiée (DateCherchée) dans l'onglet "Actif-Passif-Encours"