Probleme pour changer une date en vba

Emeric -  
eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Voila, j'ai cree un bouton sous excel 2003 pour pouvoir reperer les dates qui ont expirees dans un tableau. Des qu'une date est expiree, celui-ci me renvois a un userform qui me demande si je veux archirve le rapport qui va avec la date en question ou la prolonger.
Si je souhaite la prolonger, celui-ci me demande alors la nouvelle date et il verifie que la date est bien une date et est bien superieure a aujourd'hui.
La ou je bloque, c'est ensuite pour remplacer l'ancienne date par la nouvelle : j'ai essayer de creer une fonction pour faire ca ou essayer de declarer des variables en public mais je n'y arrive pas.

Je vous donne les deux codes : celui du bouton :

Private Sub cmd_expired_Click()

Worksheets("current approval").Select

Dim rowC As String
Dim Es As String
Dim rep As String
Dim row2 As String
Dim i As Integer
Dim a As Integer

rowC = CStr(Worksheets("current approval").Range("C65356").End(xlUp).Row)

Es = "C" + rowC

For Each cell In Application.Worksheets("current approval").Range("C2:" + Es)

If cell.Value <= Date Then

rep = Worksheets("current approval").Range("A" & cell.Row)

MsgBox ("the report" & " " & rep & " " & "expires the" & " " & cell.Value)
cell.EntireRow.Cut
expired_date.Show

End If
Next cell
End Sub

Et celui du Userform :

Private Sub cmd_extension_Click()

Dim da As String
Dim dat As Date
Dim dat2 As String
Dim BDC_date As String

da = InputBox("Please enter the new Audit's date (format ddmmyyyy)")

Do
If IsDate(da) Then
Else
If IsNumeric(da) Then
If Len(da) = 6 Then
BDC_date = Left(da, 2) & "/" & Mid(da, 3, 2) & "/20" & Right(da, 2)
End If
If Len(da) = 8 Then
BDC_date = Left(da, 2) & "/" & Mid(da, 3, 2) & "/" & Right(da, 4)
End If
End If
If IsDate(BDC_date) Then
da = BDC_date
Else
MsgBox ("the audit's date is incorrect")
da = InputBox("Please enter the correct audit's date (format ddmmyyy)")
End If
End If
Loop While IsDate(da) = False

dat = CDate(da)

Do
If dat <= Date Then

dat2 = InputBox("Please enter an audit's date after" & Date)

If StrPtr(dat2) = 0 Then
End
End If

If IsDate(dat2) Then
Else
If IsNumeric(dat2) Then
If Len(dat2) = 6 Then
BDC_date = Left(dat2, 2) & "/" & Mid(dat2, 3, 2) & "/20" & Right(dat2, 2)
End If
If Len(dat2) = 8 Then
BDC_date = Left(dat2, 2) & "/" & Mid(dat2, 3, 2) & "/" & Right(dat2, 4)
End If
End If
If IsDate(BDC_date) Then
dat2 = BDC_date
End If
End If
dat = CDate(dat2)
End If
Loop While dat <= Date
End Sub

Je n'ai pas l'habitude de poser des questions mais lá, depuis jeudi dernier, je suis bloqué.
Merci pour vos réponses.

PS : désole pour les accents qui ne sont pas toujours mis je pense, mais je suis en stage en Angleterre et je galére un peu avec le clavier qwerty.
Configuration: Windows XP
Internet Explorer 6.0

3 réponses

  1. Emeric
     
    Desole de relancer mon post, mais je suis vraiment bloqué.

    Pour essayer d'expliquer un peu mieux ce que je fais, mon userform demande á l'utilisateur de rentrer une nouvelle date et cette date doit remplacer celle qui est expirée sur ma feuille, j'ai un peu modifié les codes depuis tout a l'heure mais c'est pas terrible : pour le bouton :

    Private Sub cmd_expired_Click()

    Dim rowC As String
    Dim Es As String
    Dim rep As String
    Dim row2 As String
    Dim i As Integer
    Dim a As String
    Dim l As String
    Dim da As Date

    Sheet3.Range("C1").Select

    rowC = CStr(Worksheets("current approval").Range("C65356").End(xlUp).Row)

    Es = "C" + rowC
    i = 0

    For Each cell In Application.Worksheets("current approval").Range("C2:" + Es)
    i = i + 1

    Worksheets("current approval").Select
    l = Selection.Cells(2, 1).Select
    MsgBox (l)
    If cell.Value <= Date Then

    rep = Worksheets("current approval").Range("A" & cell.Row)

    MsgBox ("the report" & " " & rep & " " & "expires the" & " " & cell.Value)
    cell.EntireRow.Cut
    expired_date.Show
    End If
    Next cell

    End Sub

    Pour le userform :

    Dim da As String
    Dim dat As Date
    Dim dat2 As String
    Dim BDC_date As String

    da = InputBox("Please enter the new Audit's date (format ddmmyyyy)")

    Do
    If IsDate(da) Then
    Else
    If IsNumeric(da) Then
    If Len(da) = 6 Then
    BDC_date = Left(da, 2) & "/" & Mid(da, 3, 2) & "/20" & Right(da, 2)
    End If
    If Len(da) = 8 Then
    BDC_date = Left(da, 2) & "/" & Mid(da, 3, 2) & "/" & Right(da, 4)
    End If
    End If
    If IsDate(BDC_date) Then
    da = BDC_date
    Else
    MsgBox ("the audit's date is incorrect")
    da = InputBox("Please enter the correct audit's date (format ddmmyyy)")
    End If
    End If
    Loop While IsDate(da) = False

    dat = CDate(da)

    Do
    If dat <= Date Then

    dat2 = InputBox("Please enter an audit's date after" & Date)

    If StrPtr(dat2) = 0 Then
    End
    End If

    If IsDate(dat2) Then
    Else
    If IsNumeric(dat2) Then
    If Len(dat2) = 6 Then
    BDC_date = Left(dat2, 2) & "/" & Mid(dat2, 3, 2) & "/20" & Right(dat2, 2)
    End If
    If Len(dat2) = 8 Then
    BDC_date = Left(dat2, 2) & "/" & Mid(dat2, 3, 2) & "/" & Right(dat2, 4)
    End If
    End If
    If IsDate(BDC_date) Then
    dat2 = BDC_date
    End If
    End If
    dat = CDate(dat2)
    End If
    Loop While dat <= Date

    Worksheets("current approval").Select
    Selection.Cells(1, 1).Value = dat
    End

    Merci
    0
  2. Emeric
     
    désolé de relancer mon sujet, mais ce matin, j'y suis toujours dessus et j'y arrive toujours pas.

    Déjá, une question surement simple, au début quand l'utilisateur clique sur le bouton, je lui demande de sélectionner la feuille 3 et la cellule C1. Et déjá la il me met une erreur :

    Sheet3.Range("C1").Select

    l'erreur est :

    Run-time error 1004
    select method of range class failed

    Merci de m'éclairer
    0
  3. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonsoir,

    Sans doute trop tard mais essaie avec worksheets("Sheet3").Range("C1").Select
    eric
    0