Problèmes pour écrire le code correspondant à ma demande

Bonsoir à tous,

Je suis toujours en train d'optimiser mon fichier de gestion de ma collection de pièces canadiennes... Ce soir, je suis bloquée parce que j'aimerais différencier les pièces "en circulante" de celles de collection ("BU")...

J'ai essayé à partir du fichier joint, d'écrire les lignes de code me demandant de choisir entre "circulante" et "BU" mais sans succès, pour l'instant. Voilà ce que je recherche:

1. lorsque je clique sur une image, une inputbox me demande l'année,

2. lorsque j'ai entré l'année, j'aimerais qu'une msgbox me demande s'il s'agit d'une BU ou d'une circulante,

3. selon ma réponse, j'aimerais qu'une msgbox m'informe du nombre d'exemplaire de cette pièce que j'ai dans ma collection et me demande si je souhaite en ajouter une,

4. si je réponds oui, j'aimerais que le stock soit incrémenté de 1 dans la feuille "récapitulatif".

Voilà, j'espère avoir été claire dans ma demande...

Merci beaucoup de votre aide,

Bonne soirée,

Bien amicalement

Bonsoir à tous,

Voilà où j'en suis (je sais... ce n'est pas brillant...)

Dim Col As Long
Dim Lig As Long
Dim Description As String
Dim Annee As String
Dim Cel As Range
Dim lg As Long
Dim Cl As Integer

  Col = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
  Lig = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
  Description = Cells(Lig, Col - 3)
With Sheets("Récapitulatif")
If MsgBox("Circulante?", vbYesNo) = vbYes Then
Set Cel = .Columns("B:AA").Find(what:=Description, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
    If Cel.Offset(0, 2) >= 0 Then
If MsgBox("Vous possédez " & Cel.Offset(0, 2) & " pièce(s) " & "'" & Description & "'" & vbCr & _
"Voulez-vous en rajouter une de plus ? ", vbInformation + vbYesNo, _
"Mis à jour du stock") <> vbYes Then Exit Sub
End If
Cel.Offset(0, 2) = Cel.Offset(0, 2) + 1
Else
Set Cel = .Columns("B:AA").Find(what:=Description, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
    If Cel.Offset(0, 3) >= 0 Then
If MsgBox("Vous possédez " & Cel.Offset(0, 4) & " pièce(s) " & "'" & Description & "'" & vbCr & _
"Voulez-vous en rajouter une de plus ? ", vbInformation + vbYesNo, _
"Mis à jour du stock") <> vbYes Then Exit Sub
End If
Cel.Offset(0, 3) = Cel.Offset(0, 3) + 1
Else
MsgBox "Description non trouvé : " & Description
End If
End With
End Sub

Sans surprise, ça ne fonctionne pas.... Quelqu'un peut-il m'expliquer pourquoi ??

Merci beaucoup,

Bonne soirée,

Bien amilcalement

Bonsoir à tous !

Personne n'a d'idées ??

Bonne soirée !

Bien amicalement

Mes maigres progrès...

   Option Explicit

Sub Stockage2()
Dim Col As Long
Dim Lig As Long
Dim Description As String
Dim Annee As String
Dim Cel As Range
Dim lg As Long
Dim Cl As Integer

      Col = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
      Lig = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
      Description = Cells(Lig, Col - 2)
    With Sheets("Récapitulatif")
    If MsgBox("Circulante?", vbYesNo) = vbYes Then
        Set Cel = .Columns("B:AA").Find(what:=Description, LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
        If Cel.Offset(0, 1) >= 0 Then
    If MsgBox("Vous possédez " & Cel.Offset(0, 1) & " pièce(s) " & "'" & Description & "'" & vbCr & _
    "Voulez-vous en rajouter une de plus ? ", vbInformation + vbYesNo, _
    "Mis à jour du stock") <> vbYes Then Exit Sub
    End If
    Cel.Offset(0, 1) = Cel.Offset(0, 1) + 1
    Else

    Set Cel = .Columns("B:AA").Find(what:=Description, LookIn:=xlValues, lookat:=xlWhole)
    If Not Cel Is Nothing Then
        If Cel.Offset(0, 2) >= 0 Then
    If MsgBox("Vous possédez " & Cel.Offset(0, 2) & " pièce(s) " & "'" & Description & "'" & vbCr & _
    "Voulez-vous en rajouter une de plus ? ", vbInformation + vbYesNo, _
    "Mis à jour du stock") <> vbYes Then Exit Sub
    End If
    Cel.Offset(0, 2) = Cel.Offset(0, 2) + 1
    Else
    MsgBox "Description non trouvé : " & Description
    End If
    End If

    End If
    End With
    End Sub
     
Rechercher des sujets similaires à "problemes ecrire code correspondant demande"