Programme Gestion cave à vins

Question

Trouvera la solution à mon problème: Je réalise un petit programme de gestion de cave. a chaque vin correspond une ligne avec différentes données. En face de chaque vin, je voudrais faire apparaître l’apogée sous forme d’une image (bouteille debout, oblique, couchée ou retournée) pour illustrer quand elle est bonne à boire. (ou non…) j’ai écrit une fonction logique qui détermine l’image à afficher pour chaque vin (fonction du millésime et du type de vin). mais ma fonction logique n’affiche que des valeurs (chiffres ou lettres); comment afficher des images? Évidement pour fêter le résultat j’offrirai une (bonne) bouteille au premier ou à la première qui me trouvera une solution, sachant que je ne pratique pas VBA santé ! Edit Dan : Remplacé titre du sujet J’offre une (bonne) bouteille à celui / celle qui...

Curulis · Accepted Answer

Salut Alerion,
Salut l'équipe,

voici quelque chose qui a l'air de vouloir fonctionner.

Déso, j'ai supprimé les formules pour laisser VBA arranger ses bidons !
- le calcul est global lors d'un passage d'année (pas effacer [B1]) ;
- le calcul est localisé à la ligne dont tu changes les valeurs en [I:J] ;
- les APOGEES calculées sont inscrites en [K], couleur blanche ;
- les images sont affichées en [K].

Mieux, je ne pense pas pouvoir faire...

Public Sub Apogée(ByVal iIdx%)
'
Dim oPic As Object, rCel As Range, tTab, iRow%, sRep$, sBottle1$, sBottle2$
'
Application.ScreenUpdating = False
'
On Error Resume Next
With Worksheets("CAVE")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    tTab = .Range("I1:K" & iRow).Value
    For x = IIf(iIdx = 0, 3, iIdx) To IIf(iIdx = 0, iRow, iIdx)
        sRep = fctCalcul(CInt(tTab(x, 1)), CInt(tTab(x, 2)))
        If sRep <> CStr(tTab(x, 3)) Then
            sBottle1 = "Bottle" & tTab(x, 3) & "_" & x
            .Shapes(sBottle1).Delete
            tTab(x, 3) = sRep
            sBottle1 = "Bottle" & sRep
            Set oPic = Worksheets("SHAPES").Shapes(sBottle1)
            oPic.Copy
            .Paste Destination:=.Range("K" & x)
            sBottle1 = "Bottle" & sRep
            sBottle2 = "Bottle" & sRep & "_" & x
            .Shapes(sBottle1).Name = sBottle2
            Set oPic = .Shapes(sBottle2)
            Set rCel = .Range("K" & x)
            With oPic
                .Top = rCel.Top + 1
                .Left = rCel.Left + (rCel.Width / 3)
            End With
        End If
    Next
    .Range("I1:K" & iRow).Value = tTab
    .Columns.AutoFit
    .[A1].Select
End With
On Error GoTo 0
'
Application.ScreenUpdating = True
'
End Sub

115cave-alerion-v2.xlsm (119.51 Ko)

A+

Curulis · Answer

Avant de penser à boire, ce serait plus facile pour nous d'avoir quelques lignes de ta BDD, les images et ta fonction, histoire de visualiser l'affaire. - l'image peut être affichée au format de la cellule ; - elle peut être intégrée à un commentaire et donc, visible uniquement quand on survole la cellule. J'imagine que c'est la première solution que tu souhaites ? A+...

Dan · Answer

Déjà mettre un bonjour serait bienvenu ! Ensuite passer un moment à lire ces quelques lignes qui vous aideront dans vos demandes et réponses sur ce forum --&gt; https://forum.excel-pratique.com/excel/a-lire-avant-de-poster-charte-du-forum-et-informations-utiles... Le titre du sujet sera édité --&gt; "J’offre une (bonne) bouteille à celui / celle qui" Cordialement...

Ordonc · Answer

Bonjour… Un exemple pour le choix de l’état mais loin d’être complet ( pas de corrections encore prévues … ) et cependant, suite très simple à développer . Celui-ci est du type caractère en fonte spéciale WingDings avec couleur et commentaire. edit prémonitoire : « Merci pour l’offre, je viens d’arroser mon repas avec la bonne bouteille ! »...

Curulis · Answer

Non, pas du 57 mais de '57... Premier jet, n'ayant pas eu le temps espéré de chipoter sur ton fichier, temps que je n'aurai pas plus avant la prochaine soirée. En l'état, le calcul se déclenche à l'ouverture du fichier et les bouteilles se placent sur la colonne &#91;K&#93;, histoire de cacher les lettres des formules. La version finale verra d'autres modes de calcul, plus souples et ciblés. Patience ou espérer l'intervention d'un crack ! Private Sub Workbook_Open() ' With Worksheets("CAVE") For Each Shape In .Shapes Shape.Delete Next ' For x = 3 To .Range("K" & Rows.Count).End(xlUp).Row For Each Shape In Worksheets("SHAPES").Shapes If Shape.Name = "Bottle" & .Range("K" & x).Value Then _ Shape.Copy: _ Worksheets("CAVE").Paste Destination:=.Range("K" & x): _ Exit For Next Next End With ' End Sub A+...

Curulis · Answer

Quand tu auras 17.000 bouteilles, tu comprendras pourquoi il faut améliorer le code ! Comme ta formule en &#91;K&#93; repose sur les années, il faut faire en sorte que le calcul ne se produise que : - lors du passage d'une année à l'autre pour l'ensemble des bouteilles ; - à l'encodage d'une nouvelle bouteille ou lors d'une correction en &#91;I&#93;-&#91;J&#93; pour une seule bouteille . Pour la beauté du geste, il faut aussi centrer les images sur leur cellule, automatiser les bordures, etc... Un peu de taf, quoi ! A+...

Arturo83 · Answer

Il serait bien de répondre aussi sur l'autre demande apparemment identique https://forum.excel-pratique.com/excel/programme-gestion-cave-a-vins-160089 . Cdlt...

21Formatic · Answer

Oui, c'est possible. Mais il faut créer autant de formes pour réceptionner l'image, que de lignes. Donc oui c'est possible, mais non ça ne se fera pas sans VBA...