Gestion d'une Cave

Bonjour à toutes et à tous,

Voici un sujet personnel que je voudrais améliorer.

Je possède un certain nombre de bouteilles de diverses régions et de différents millésimes dans ma cave.

En chercher sur ce forum, j'ai créé un formulaire de saisie qui sert également à la consultation et à la modification de mon stock.

1ère question:

Dans les colonnes D et L, il existe une formule. Comment faire lors d'une nouvelle saisie pour que les formules soient reproduites dans la ligne créée? Pour l'instant j'ai reproduit les formules jusqu'à la ligne 100, mais je voudrais que ce soit automatique.

2ème question:

Quand un millésime est épuisé, j'ai créé la touche "Suppression", mais ma macro va directement au 1er enregistrement trouvé dans la colonne E. C'est OK quand il n'y a pas de doublon et que l'appellation est bien orthographiée. Si erreur dans l'orthographe, j'ai ce message "Erreur d'exécution '1004': La méthode 'Range' de l'objet'_Global' a échoué.

Merci de me venir en aide.

Je vous joins mon fichier.

Trés cordialement

Henri

Bonjour,

Je n'arrive pas à utiliser ton fichier. Merci de le mettre au format XLS.

Pour la première question, comment ajoutes-tu une donnée ? Par bouton avec macro ou manuellement par insertion ligne ?

Amicalement

j'ai reussi a l'ouvrir voir si c'est bon

a +

Bonsoir Dan et guigui,

J'ajoute une nouvelle ligne par le bouton "Ajout d'un nouveau vin" du formulaire.

Jusqu'à la ligne 100 je n'ai pas de problèmes car les formules sont présentes dans les colonnes D et L. Mais je voudrais supprimer ces formules dans les lignes vides et qu'elles s'initialisent automatiquement au moment de la création d'un nouvel enregistrement.

ci-joint le fichier en XLS

Amicalement

Henri

Re,

Dans le code "Private Sub Valid click" de l'userform mets cette instruction :

Sheets("livre de cave").Cells(ligne, 4).FormulaR1C1 = "=R" & ligne & "C[3]-R" & ligne & "C[4]"

Si ok, n'oublie pas de cloturer le fil en cliquant sur le V de couleur Vert car je vois que plusieurs d'autres fils sont toujours ouverts.

Amicalement

Merci Dan,

C'est bien la bonne formule. Je l'ai adaptée pour la colonne L comme suit:

Sheets("livre de cave").Cells(ligne, 12).FormulaR1C1 = "=R" & ligne & "C[-5]*R" & ligne & "C[-1]"

Ma 1ère question est résolue.

As-tu regardé la 2ème question concernant la suppression d'un millésime épuisé?

Bonne journée

Henri

re,

suppression d'un millésime épuisé?

Le code m'a l'air compliqué là.. Comment fonctionnes-tu dans cette suppression ?

Une idée serait que si tu veux supprimer un millésime, il se fait sur base de la quantité restante qui est nulle.

Dans cet esprit, tu peux sélectionner simplement une cellule de la ligne à supprimer et le code vérifie bien que la quantité restante est à 0. Si oui, on supprime la ligne. Si non une boite à message t'indique qu'il rest encore des bouteilles.

Si ok je te corrige le code

Re-bonjour Dan

Pour la suppression d'un millésime, je choisis la colonne E (appellations) et dans l'InputBox je saisis l'appellation concernée.

Cette méthode est la même que Claude Dubois m'avait indiquée dans un fil antérieur (amélioration d'une macro).

Un contrôle se fait sur la colonne D (qté restante). Si elle # de 0, message d'erreur. Cette manip fonctionne bien.

Mon soucis est : S'il existe des doubons (millésimes différents mais même appellation), le positionnement s'effectue sur le 1er article trouvé et non pas forcément sur celui qui a 0 en col D.

Mais ce n'est pas grave. Cette appli ne sert qu'à moi.

Amicalement

Henri

re,

Essaie avec ce code qui ne supprimera les données que si la cellule D est nulle et ce, pour l'appellation que tu as choisie. Un message te demandera de confirmer la suppression des données de cette ligne.

Sub supprime()
Dim conf As Integer
Dim reponse As String
Dim premcel, cel
reponse = InputBox("Entrez l'Appellation du vin à Supprimer")
If reponse = "" Then Exit Sub
On Error GoTo FIN
With Range("E6:E" & Range("E65536").End(xlUp).Row)
    Set cel = .Find(reponse, LookIn:=xlValues, LookAt:=xlWhole)
    If Not cel Is Nothing Then
        premcel = cel.Address
        Do
         If Range(cel.Address).Offset(0, -1) = 0 Then
            conf = MsgBox("Confirmez-vous la suppression" & Chr(10) & _
            "du vin: " & reponse & " ?", vbYesNo + vbCritical + vbDefaultButton2, "Suppression")
            If conf = vbYes Then
            Range(cel.Address).EntireRow.ClearContents
            MsgBox ("Les Données du Vin : " & reponse & "  sont effacées.")
            End If
        End If
        Set cel = .FindNext(cel)
        Loop While Not cel Is Nothing And cel.Address <> premcel
        Call Quantité
    End If
End With
Exit Sub
FIN: MsgBox "L'appellation n'existe pas !"
End Sub

A te relire

Merci Dan,

Ce code correspond à mon attente.

Petite rectif faite pour cette instruction

Range(cel.Address).EntireRow.ClearContents

par

Range(cel.Address).EntireRow.Delete Shift:=xlUp

Par contre si je saisis une appellation qui n'existe pas, je n'ai pas le message d'erreur, mais c'est à moi de bien faire la saisie.

Je clos ce fil et merci encore.

Bonne soirée

Henri

re,

je n'ai pas le message d'erreur

Oups, change ceci dans le code :

1. Supprime les 3 lignes suivantes

ON ERROR GOTO FIN
Exit Sub
FIN: MsgBox "L'appellation n'existe pas !"

2. Mets cette ligne juste après CALL QUANTITE

Else: MsgBox "L'appellation n'existe pas !"

Amicalement

bonjour

je me suis permis de télécharger votre fichier, juste pour voir ce que cela donne car je suis aussi un amateur de vins et je gère ma cave avec un petit fichier excel ... mais tout simple car je ne gère pas du tout les macros

très bien votre "système" pour entrer les nouveaux vins achetés

cordialement

Bonsoir,

Je ne sais pas s'il s'agit du même fil.

Si c'est le cas, j'ai modifié mon fichier depuis ce temps et ça marche mieux. Il ya surement quelques petites choses à améliorer mais je l'utilise avec cette version avec beaucoup de satisfaction.

En P.J. ma nouvelle version utilisable avec Excal 2007 et plus.

Cordialement

Henri