Cave à vins ( avec macro) 2018-03-08

Toubabou · 8 Octobre 2019

JOZZ à dit:
Bonjour Toubabou et le forum,

Les commentaires saisis sont enregistrés au bon endroit, c'est l'affichage de celui-ci qui ne pointe pas ou il faut.
Procède à la modification ci-jointe dans la UserForm Jugement, et tout devrait rentrer dans l'ordre. Donc pas besoin d'ajout...

Amicalement Jozz

Regarde la pièce jointe 1042880

Bonsoir JOZZ,
Chez moi cela ne fonctionne pas . Plus aucuns commentaires ne s'affichent
Merci beaucoup
Toubabou

JOZZ · 8 Octobre 2019

Re,

Toubabou à dit:
Chez moi cela ne fonctionne pas . Plus aucuns commentaires ne s'affichent

Peux-tu poster ton fichier, et j'y jetterai un coup d'oeil pour éventuellement te dépanner...
Jozz

Toubabou · 8 Octobre 2019

Bonsoir JOZZ,
Voilà mon fichier.
Juste une question au passage. lorsque l'on mets par exemple une appréciation pour Porto, Ce commentaire ne devrait-il pas s’inscrire pour toutes les bouteilles de Porto de même nom?
Toubabou

JM27 · 15 Octobre 2019

bonjour
De retour de vacances (au soleil de la Réunion)
Pour Toubalou: petit bug dans l'usf Jugement
Copier tout le module ci dessous dans le module de cet USFJugement
A priori la solution de Jozz n'est pas fonctionnelle (ListCount indique le nombre d'items dans la liste , on va donc chercher la valeur de la ligne correspondante au nb d'item plus 2)
il faut donc au moment de l'initialise ranger dans la list box le n° de la ligne ( colonne 7 non visible)
et l'afficher au double clic dans commentaire.
De plus effectivement il faut dans la feuille mouvement copier ce commentaires dans les même vins.

Pour Jozz je regarde ton pb de contrôle tip text

VB:

Option Explicit
Private Sub CmbAnnuler_Click()
    Unload Me
End Sub
Private Sub ListVinConsommé_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListVinConsommé.ListCount = 0 Then
MsgBox "Liste vide>>> Aucun vin à commenter !", vbCritical, "Information"
Unload USFJugement
Exit Sub
Else
    Me.TxtCommentaires = Sheets("Mouvements").Cells(Me.ListVinConsommé.List(Me.ListVinConsommé.ListIndex, 7), 11)
    Me.FrameCommentaire.Visible = True
    TxtCommentaires.SetFocus
    End If
End Sub


Private Sub UserForm_Initialize()
    Dim CompteurDeLigne As Long
    Dim NbLigneUtilisée As Long
    Dim Derligne As Long
    Me.ListVinConsommé.ColumnWidths = "85;80;130;110;100;53"
    With Sheets("Mouvements")
        Derligne = .Range("A65536").End(xlUp).Row
        For CompteurDeLigne = Derligne To 2 Step -1
            If .Cells(CompteurDeLigne, 9) > Date - 31 Then
            Me.ListVinConsommé.AddItem
            'Date conso
            Me.ListVinConsommé.List(NbLigneUtilisée, 0) = .Cells(CompteurDeLigne, 9)
            ' Région
            Me.ListVinConsommé.List(NbLigneUtilisée, 1) = .Cells(CompteurDeLigne, 1)
            'Appellation
            Me.ListVinConsommé.List(NbLigneUtilisée, 2) = .Cells(CompteurDeLigne, 2)
            'Désignation
            Me.ListVinConsommé.List(NbLigneUtilisée, 3) = .Cells(CompteurDeLigne, 3)
            'Année
            Me.ListVinConsommé.List(NbLigneUtilisée, 4) = .Cells(CompteurDeLigne, 4)
            'Année
            Me.ListVinConsommé.List(NbLigneUtilisée, 5) = .Cells(CompteurDeLigne, 5)
            Me.ListVinConsommé.List(NbLigneUtilisée, 6) = .Cells(CompteurDeLigne, 13)
            Me.ListVinConsommé.List(NbLigneUtilisée, 7) = CompteurDeLigne
            NbLigneUtilisée = NbLigneUtilisée + 1
            Else
                Exit For
            End If
        Next
    End With
End Sub
Private Sub CmbValider_Click()
    Dim CompteurDeLigne As Long
    Dim Derligne As Long
    Dim ItmSélectionné As Integer
    If Me.TxtCommentaires <> "" Then
        For ItmSélectionné = 0 To (ListVinConsommé.ListCount - 1)
                If ListVinConsommé.Selected(ItmSélectionné) = True Then
                    Exit For
                End If
        Next
        With Sheets("Mouvements")
            Derligne = .Range("A65536").End(xlUp).Row
            For CompteurDeLigne = Derligne To 2 Step -1
                If .Cells(CompteurDeLigne, 1) = Me.ListVinConsommé.List(ItmSélectionné, 1) _
                    And .Cells(CompteurDeLigne, 2) = Me.ListVinConsommé.List(ItmSélectionné, 2) _
                    And CStr(.Cells(CompteurDeLigne, 3)) = Me.ListVinConsommé.List(ItmSélectionné, 3) _
                    And CStr(.Cells(CompteurDeLigne, 5)) = CStr(Me.ListVinConsommé.List(ItmSélectionné, 5)) Then
                        .Cells(CompteurDeLigne, 11) = Me.TxtCommentaires
                End If
            Next
        End With
        With Sheets("Données")
                Derligne = .Range("A65536").End(xlUp).Row
                For CompteurDeLigne = Derligne To 2 Step -1
                    If .Cells(CompteurDeLigne, 1) = Me.ListVinConsommé.List(ItmSélectionné, 1) _
                    And .Cells(CompteurDeLigne, 2) = Me.ListVinConsommé.List(ItmSélectionné, 2) _
                    And CStr(.Cells(CompteurDeLigne, 3)) = Me.ListVinConsommé.List(ItmSélectionné, 3) _
                    And CStr(.Cells(CompteurDeLigne, 5)) = CStr(Me.ListVinConsommé.List(ItmSélectionné, 5)) Then
                        .Cells(CompteurDeLigne, 20) = Me.TxtCommentaires
                    End If
                Next
        End With
        With Sheets("Localisation")
            Derligne = .Range("A65536").End(xlUp).Row
            For CompteurDeLigne = Derligne To 2 Step -1
              If .Cells(CompteurDeLigne, 1) = Me.ListVinConsommé.List(ItmSélectionné, 1) _
                    And .Cells(CompteurDeLigne, 2) = Me.ListVinConsommé.List(ItmSélectionné, 2) _
                    And CStr(.Cells(CompteurDeLigne, 3)) = Me.ListVinConsommé.List(ItmSélectionné, 3) _
                    And CStr(.Cells(CompteurDeLigne, 5)) = CStr(Me.ListVinConsommé.List(ItmSélectionné, 5)) Then
                    .Cells(CompteurDeLigne, 17) = Me.TxtCommentaires
               End If
            Next
        End With
        MsgBox "Commentaire pris en compte"
        Unload Me
    Else
        MsgBox " pas de commentaire indiqué"
    End If
End Sub

Edit: apparemment JOZZ tu as trouvé la solution du contrôle tiptext

JM27 · 15 Octobre 2019

Bonsoir
pour JOZZ

'***********On vide le ControlTipText (info bulle au passage de la souris >>> 'Vin arrivé à terme')
'Me.Controls("TextBox" & CompteurDeLigneModifié & CompteurDeColonneModifié).ControlTipText = Empty
'***********

ne fonctionne pas a priori

il faut modifier le module de classe comme ci dessous

VB:

Public WithEvents groupebouton As MSForms.TextBox
Private Sub groupebouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim Réponse As String
    Dim Derligne As Long
    Dim Ligne As Byte
    Dim Colonne As Byte
    Dim Cell As Range
    ValeurTextbox = Right(groupebouton.Name, Len(groupebouton.Name) - 7)
    Ligne = Left(ValeurTextbox, 2)
    Colonne = Right(ValeurTextbox, 2)
    ValeurTextbox = Ligne & Colonne
    With Sheets("Localisation")
        'if UserFormCasier.OptConsulter = True Then
            For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                If CStr(Cell.Offset(0, 8)) = UserFormCasier.ComboCasier.Value Then
                    If CStr(ValeurTextbox) = Cell.Offset(0, 9) & Cell.Offset(0, 10) Then
                        If Cell.Offset(0, 6) <= Year(Date) Then
                            UserFormCasier.Controls(groupebouton.Name).ControlTipText = "Vin arrivé à terme"
                         End If
                   
                   
                   
                    End If
                   
                   
                End If
            Next
        'ElseIf UserFormCasier.OptPrélever = True Or UserFormCasier.OptDéplacer = True Then
        'End If
    End With
End Sub
Private Sub groupebouton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Réponse As String
    Dim Derligne As Long
    Dim Cell As Range
    Dim ValeurTextbox As String
    Dim Ligne As Byte
    Dim Colonne As Byte
 
        If MémoireRangementManuel = False Then
            If UserFormCasier.OptConsulter = True Then
                    MémoireTransfertEnCours = False
                    ValeurTextbox = Right(groupebouton.Name, Len(groupebouton.Name) - 7)
                    Ligne = Left(ValeurTextbox, 2)
                    Colonne = Right(ValeurTextbox, 2)
                    ValeurTextbox = Ligne & Colonne
                    With Sheets("Localisation")
                        For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                            If CStr(Cell.Offset(0, 8)) = UserFormCasier.ComboCasier.Value Then
                                If CStr(ValeurTextbox) = Cell.Offset(0, 9) & Cell.Offset(0, 10) Then
                                    MsgBox " Le vin dans cette cellule : " & Chr(10) & Chr(10) & Chr(149) & " Région : " & Cell & Chr(10) & Chr(149) & " Appellation : " & Cell.Offset(0, 1) _
                                    & Chr(10) & Chr(149) & " Nom : " & Cell.Offset(0, 2) & Chr(10) & Chr(149) & " Couleur : " & Cell.Offset(0, 3) & Chr(10) & Chr(149) & " Année : " & Cell.Offset(0, 4) _
                                    & Chr(10) & Chr(149) & " Acheteur : " & Cell.Offset(0, 18) & Chr(10) & Chr(149) & " Cote : " & Cell.Offset(0, 19)
                                    Exit Sub
                                End If
                            End If
                        Next
                    End With
            ElseIf UserFormCasier.OptPrélever = True Then
                MémoireTransfertEnCours = False
                SortieDestination = False
                ValeurTextbox = Right(groupebouton.Name, Len(groupebouton.Name) - 7)
                    Ligne = Left(ValeurTextbox, 2)
                    Colonne = Right(ValeurTextbox, 2)
                    ValeurTextbox = Ligne & Colonne
                    With Sheets("Localisation")
                        For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                            If CStr(Cell.Offset(0, 8)) = UserFormCasier.ComboCasier.Value Then
                                If CStr(ValeurTextbox) = Cell.Offset(0, 9) & Cell.Offset(0, 10) Then
                                    MsgBox " Le vin dans cette cellule : " & Chr(10) & Chr(10) & Chr(149) & " Région : " & Cell & Chr(10) & Chr(149) & " Appellation : " & Cell.Offset(0, 1) _
                                    & Chr(10) & Chr(149) & " Nom : " & Cell.Offset(0, 2) & Chr(10) & Chr(149) & " Couleur : " & Cell.Offset(0, 3) & Chr(10) & Chr(149) & " Année : " & Cell.Offset(0, 4) _
                                    & Chr(10) & Chr(149) & " Acheteur : " & Cell.Offset(0, 18)
                                   
                                    PrixAchat = Cell.Offset(0, 14)
                                    Réponse = MsgBox("Voulez vous prélever ce vin", vbYesNo + vbQuestion)
                                    If Réponse = vbYes Then
                                       
                                        UserFormDestination.Show
                                        If SortieDestination = False Then
                                            MsgBox " la destination de la bouteille n'ayant pas été correctement documentée, sortie non réalisée"
                                            Unload UserFormDestination
                                            Exit Sub
                                        End If
                                       
                                        With Sheets("Mouvements")
                                            Derligne = .Range("A65536").End(xlUp).Row + 1
                                            .Cells(Derligne, 1) = Cell
                                            .Cells(Derligne, 2) = Cell.Offset(0, 1)
                                            .Cells(Derligne, 3) = Cell.Offset(0, 2)
                                            .Cells(Derligne, 4) = Cell.Offset(0, 3)
                                            .Cells(Derligne, 5) = Cell.Offset(0, 4)
                                            .Cells(Derligne, 6) = UserFormCasier.ComboCasier.Value
                                            .Cells(Derligne, 7) = Cell.Offset(0, 9)
                                            .Cells(Derligne, 8) = Cell.Offset(0, 10)
                                            .Cells(Derligne, 9) = Date
                                            .Cells(Derligne, 10) = 1
                                            .Cells(Derligne, 11) = Cell.Offset(0, 16)
                                            .Cells(Derligne, 12) = Cell.Offset(0, 15)
                                            .Cells(Derligne, 13) = Cell.Offset(0, 18)
                                            .Cells(Derligne, 14) = Cell.Offset(0, 20)
                                            If UserFormDestination.OptConsoPerso = True Then
                                                .Cells(Derligne, 15) = UserFormDestination.OptConsoPerso.Caption
                                            ElseIf UserFormDestination.OptEchange = True Then
                                                .Cells(Derligne, 15) = UserFormDestination.OptEchange.Caption
                                            ElseIf UserFormDestination.OptVente = True Then
                                                .Cells(Derligne, 15) = UserFormDestination.OptVente.Caption
                                                .Cells(Derligne, 16) = CDbl(UserFormDestination.TxtPrixVente)
                                                .Cells(Derligne, 17) = CDbl(UserFormDestination.TxtPrixAchat)
                                                .Cells(Derligne, 18) = CDbl(UserFormDestination.txtPlusValue)
                                           End If
                                           
                                        End With
                                        With Sheets("Données")
                                            For Each Cellule In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                                                If Cell.Offset(0, 20) = Cellule.Offset(0, 28) Then
                                                   
                                                    Cellule.Offset(0, 18) = Cellule.Offset(0, 18) - 1
                                                    Exit For
                                                End If
                                            Next
                                       End With
                                       Cell.EntireRow.Delete
                                       Unload UserFormDestination
                                       UserFormCasier.Controls(groupebouton.Name).BackColor = &H80000005
                                       MsgBox " Prélévement exécuté"
                                       Exit Sub
                                   End If
                                End If
                            End If
                        Next
                    End With
            ElseIf UserFormCasier.OptDéplacer = True Then
                   ValeurTextbox = Right(groupebouton.Name, Len(groupebouton.Name) - 7)
                    Ligne = Left(ValeurTextbox, 2)
                    Colonne = Right(ValeurTextbox, 2)
                  If MémoireTransfertEnCours = False Then
                    ValeurTextbox = Ligne & Colonne
                      With Sheets("Localisation")
                              For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                                  If CStr(Cell.Offset(0, 8)) = UserFormCasier.ComboCasier.Value Then
                                      If CStr(ValeurTextbox) = Cell.Offset(0, 9) & Cell.Offset(0, 10) Then
                                          MsgBox " Le vin dans cette cellule : " & Chr(10) & Chr(10) & Chr(149) & " Région : " & Cell & Chr(10) & Chr(149) & " Appellation : " & Cell.Offset(0, 1) _
                                          & Chr(10) & Chr(149) & " Nom : " & Cell.Offset(0, 2) & Chr(10) & Chr(149) & " Couleur : " & Cell.Offset(0, 3) & Chr(10) & Chr(149) & " Année : " & Cell.Offset(0, 4) _
                                          & Chr(10) & Chr(149) & " Acheteur : " & Cell.Offset(0, 18)
                                          Réponse = MsgBox(" Si vous voulez déplacer ce vin cliquez sur oui, puis sélectionner la cellule de destination", vbYesNo + vbQuestion)
                                          If Réponse = vbYes Then
                                              MémoireLigneLocalisation = Cell.Row
                                              MémoireTextBoxOrigine = groupebouton.Name
                                              MémoireCouleurTextBox = UserFormCasier.Controls(groupebouton.Name).BackColor
                                              MémoireTransfertEnCours = True
                                          End If
                                          Exit Sub
                                      End If
                                  End If
                              Next
                      End With
                End If
                If MémoireTransfertEnCours = True Then
                    If UserFormCasier.Controls(groupebouton.Name).BackColor <> &H80000005 Then
                        MsgBox " On ne peut pas déplacer une bouteille dans une cellule déja occupée"
                            Exit Sub
                    End If
                        With Sheets("Localisation")
                             .Cells(MémoireLigneLocalisation, 9) = UserFormCasier.ComboCasier.Value
                             .Cells(MémoireLigneLocalisation, 10) = Ligne
                             .Cells(MémoireLigneLocalisation, 11) = Colonne
                             .Cells(MémoireLigneLocalisation, 16) = Sheets("Déroulants").Range("U" & Colonne + 1) & Ligne
                             UserFormCasier.Controls(MémoireTextBoxOrigine).BackColor = &H80000005
                             UserFormCasier.Controls(MémoireTextBoxOrigine).ControlTipText = Empty
                           
                             UserFormCasier.Controls(groupebouton.Name).BackColor = MémoireCouleurTextBox
                             MémoireTransfertEnCours = False
                             MsgBox " Transfert réalisé "
                        End With
                End If
            End If
        ElseIf MémoireRangementManuel = True Then
            ValeurTextbox = Right(groupebouton.Name, Len(groupebouton.Name) - 7)
            Ligne = Left(ValeurTextbox, 2)
            Colonne = Right(ValeurTextbox, 2)
            ValeurTextbox = Ligne & Colonne
            If UserFormCasier.Controls(groupebouton.Name).BackColor = &H80000005 Then
                          Réponse = MsgBox("Voulez vous ranger une bouteille dans cette cellule ? ", vbYesNo + vbQuestion)
                          If Réponse = vbYes Then
                                    With Sheets("Localisation")
                                       Derligne = .Range("A65536").End(xlUp).Row + 1
                                      .Range("A" & Derligne) = USFRentrerUnVin.ComboRégion
                                      .Range("B" & Derligne) = USFRentrerUnVin.ComboAppellation
                                      .Range("C" & Derligne) = USFRentrerUnVin.ComboDésignation
                                      .Range("D" & Derligne) = USFRentrerUnVin.ComboCouleur
                                      .Range("E" & Derligne) = CInt(USFRentrerUnVin.ComboAnnée)
                                      .Range("F" & Derligne) = Date
                                      If USFRentrerUnVin.TxtDateMaxi <> "" Then
                                      .Range("G" & Derligne) = CInt(USFRentrerUnVin.TxtDateMaxi)
                                          End If
                                      If USFRentrerUnVin.TxtDateMini <> "" Then
                                          .Range("H" & Derligne) = CInt(USFRentrerUnVin.TxtDateMini)
                                      End If
                                      .Range("I" & Derligne) = UserFormCasier.ComboCasier.Value
                                      .Range("J" & Derligne) = CByte(Ligne)
                                      .Range("K" & Derligne) = CByte(Colonne)
                                      .Range("L" & Derligne) = USFRentrerUnVin.ComboCépage
                                      .Range("M" & Derligne) = USFRentrerUnVin.ComboPotentiel
                                     If USFRentrerUnVin.ComboHarmonie1 <> "" Then
                                        .Range("N" & Derligne) = USFRentrerUnVin.ComboHarmonie1
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie2 <> "" Then
                                      .Range("N" & Derligne) = .Range("N" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie2
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie3 <> "" Then
                                      .Range("N" & Derligne) = .Range("N" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie3
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie4 <> "" Then
                                      .Range("N" & Derligne) = .Range("N" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie4
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie5 <> "" Then
                                      .Range("N" & Derligne) = .Range("N" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie5
                                     End If
                                     If USFRentrerUnVin.TxtPrix.Value <> "" Then
                                      .Range("O" & Derligne) = CDbl(USFRentrerUnVin.TxtPrix)
                                     End If
                                    .Range("P" & Derligne) = Sheets("Déroulants").Range("U" & Colonne + 1) & Ligne
                                    .Range("Q" & Derligne) = USFRentrerUnVin.TxtObservations
                                    .Range("R" & Derligne) = 1
                                    .Range("S" & Derligne) = USFRentrerUnVin.TxtAcheteur
                                    .Range("T" & Derligne) = Val(USFRentrerUnVin.TxtCote)
                                    .Range("U" & Derligne) = Clé
                                    If USFRentrerUnVin.ComboCouleur = "Rouge" Then
                                       UserFormCasier.Controls(groupebouton.Name).BackColor = RGB(109, 7, 26)
                                       UserFormCasier.Controls(groupebouton.Name).BackColor = &H8080FF
                                    ElseIf USFRentrerUnVin.ComboCouleur = "Rosé" Then
                                        UserFormCasier.Controls(groupebouton.Name).BackColor = &HFFC0FF
                                    ElseIf USFRentrerUnVin.ComboCouleur = "Blanc" Then
                                        UserFormCasier.Controls(groupebouton.Name).BackColor = RGB(123, 123, 123)
                                       UserFormCasier.Controls(groupebouton.Name).BackColor = &HC0C0C0
                                    ElseIf USFRentrerUnVin.ComboCouleur = "Effervescents" Then
                                         UserFormCasier.Controls(groupebouton.Name).BackColor = RGB(247, 255, 60)
                                    ElseIf USFRentrerUnVin.ComboCouleur = "Blanc Sec" Then
                                         UserFormCasier.Controls(groupebouton.Name).BackColor = &HFFFFC0
                                   
                                    ElseIf USFRentrerUnVin.ComboCouleur = "Liquoreux" Then
                                         UserFormCasier.Controls(groupebouton.Name).BackColor = &HC0FFC0
                                       ' UserFormCasier.Controls(groupebouton.Name).BackColor = &HFFFF&
                                    End If
                                    UserFormCasier.TxtNbBouteille.Value = UserFormCasier.TxtNbBouteille.Value - 1
                                End With
                            ' Transfert des données dans onglet données
                            With Sheets("Données")
                                If UserFormCasier.TxtNbBouteille.Value = 0 Then
                                    Derligne = .Range("A65536").End(xlUp).Row + 1
                                    .Range("A" & Derligne) = USFRentrerUnVin.ComboRégion
                                    .Range("B" & Derligne) = USFRentrerUnVin.ComboAppellation
                                    .Range("C" & Derligne) = USFRentrerUnVin.ComboDésignation
                                    .Range("D" & Derligne) = USFRentrerUnVin.ComboCouleur
                                    .Range("E" & Derligne) = CInt(USFRentrerUnVin.ComboAnnée)
                                    .Range("F" & Derligne) = USFRentrerUnVin.ComboCépage
                                    .Range("G" & Derligne) = USFRentrerUnVin.ComboPotentiel
                                    On Error Resume Next
                                      .Range("H" & Derligne) = CInt(USFRentrerUnVin.TxtDateMaxi)
                                      .Range("I" & Derligne) = CInt(USFRentrerUnVin.TxtDateMini)
                                    On Error GoTo 0
                                     If USFRentrerUnVin.ComboHarmonie1 <> "" Then
                                        .Range("J" & Derligne) = USFRentrerUnVin.ComboHarmonie1
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie2 <> "" Then
                                      .Range("J" & Derligne) = .Range("J" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie2
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie3 <> "" Then
                                      .Range("J" & Derligne) = .Range("J" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie3
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie4 <> "" Then
                                      .Range("J" & Derligne) = .Range("J" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie4
                                     End If
                                     If USFRentrerUnVin.ComboHarmonie5 <> "" Then
                                      .Range("J" & Derligne) = .Range("J" & Derligne) & " - " & USFRentrerUnVin.ComboHarmonie5
                                     End If
                                   
                                      If USFRentrerUnVin.TxtPrix <> "" Then
                                          .Range("O" & Derligne) = CDbl(USFRentrerUnVin.TxtPrix)
                                      End If
                                    .Range("P" & Derligne) = USFRentrerUnVin.TxtDateAchat
                                    .Range("Q" & Derligne) = USFRentrerUnVin.TxtLieu
                                    .Range("R" & Derligne) = CByte(USFRentrerUnVin.ComboQuantité)
                                    .Range("S" & Derligne) = CByte(USFRentrerUnVin.ComboQuantité)
                                    .Range("T" & Derligne) = USFRentrerUnVin.TxtObservations
                                    .Range("U" & Derligne) = USFRentrerUnVin.TxtContact
                                    .Range("V" & Derligne) = USFRentrerUnVin.TxtAdresse
                                    .Range("W" & Derligne) = USFRentrerUnVin.TxtVille
                                    .Range("X" & Derligne) = USFRentrerUnVin.TxtCodePostal.Value
                                    .Range("Y" & Derligne) = USFRentrerUnVin.TxtTel
                                    .Range("Z" & Derligne) = USFRentrerUnVin.TxtEmail
                                    .Range("AA" & Derligne) = USFRentrerUnVin.TxtAcheteur
                                    .Range("AB" & Derligne) = Val(USFRentrerUnVin.TxtCote)
                                    .Range("AC" & Derligne) = Clé
                                    .Range("AD" & Derligne) = USFRentrerUnVin.ComboFormat
                                    .Range("AE" & Derligne) = USFRentrerUnVin.TxtApogée.Value
                                    Sheets("Données").Select
                                    Range("A1:AG" & Derligne).Select
                                    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                                          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                          DataOption1:=xlSortNormal
                                    Application.Goto Reference:=Sheets("Menu").Range("A1"), Scroll:=True
                                    Unload USFRentrerUnVin
                                    Unload UserFormCasier
                                    MémoireRangementManuel = False
                                    MsgBox " Mise en cave réalisée"
                                End If
                        End With
                    End If
                Else
                    With Sheets("Localisation")
                        For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
                            If CStr(Cell.Offset(0, 8)) = UserFormCasier.ComboCasier.Value Then
                                If CStr(ValeurTextbox) = Cell.Offset(0, 9) & Cell.Offset(0, 10) Then
                                    MsgBox " Cette cellule est deja occupée par : " & Chr(10) & Chr(10) & Chr(149) & " Région : " & Cell & Chr(10) & Chr(149) & " Appellation " & Cell.Offset(0, 1) _
                                    & Chr(10) & Chr(149) & " Nom : " & Cell.Offset(0, 2) & Chr(10) & Chr(149) & " Couleur : " & Cell.Offset(0, 3) & Chr(10) & Chr(149) & " Année : " & Cell.Offset(0, 4)
                                 End If
                            End If
                        Next
                    End With
                End If
        End If
End Sub

Toubabou · 15 Octobre 2019

Bonsoir JM27, JOZZ, le forum,

Merci à vous deux, tout fonctionne parfaitement.
Maintenant, il ne me reste plus qu'à chercher ce qui pourrais être ajouté. Peut-être la photos du vins????

Cordialement,
Jean-Marie

JOZZ · 15 Octobre 2019

Bonsoir JM27, Toubabou et le forum,

JOZZ à dit:
Quand j'accède à la visualisation de cave, et que je change de casier (CaveAvt) le contrôle TipText m'indique la présence d'un vin arrivé à terme qui se trouve dans un autre casier (Vins de garde).
Est-il possible de corriger ce Bug, d'avance merci.
Regarde la pièce jointe 1042312

Pour JM27,
(quelle chance, la Réunion...)
A priori ma modification ne fonctionne pas !!! mais dans le fichier joint 'Ma cave Test.xlsm' il n'est pas possible de vérifier ce que j'affiche dans ma pièce jointe.
Mon fichier perso fonctionne parfaitement avec ce que j'ai indiqué. De plus je n'arrive pas à envoyer mon fichier '+ de 2Mo ???' pour avérer ma modification.
Merci pour la modif de l'UsfJugement.

Pour Toubabou
Non tout ne fonctionne pas parfaitement, dans ton fichier tu crée un casier de 20 colonnes. ce n'est pas possible puisqu'on ne peut afficher que 19 colonnes après ma modif. Si tu veux le faire il faut rajouter le nombre de Textbox nécessaire.

Jozz

Toubabou · 15 Octobre 2019

Bonsoir JOZZ,
Oups, je n'avais pas vu....
Merci beaucoup,
Bonne soirée à tous
Jean-marie

JM27 · 15 Octobre 2019

bonsoir
encore un petit bug détecté dans déplacer un vin
le programme ne faisait pas la différence entre le vin en ligne 1 colonne 11 et ligne 11 colonne 1 ( il ne fallait pas concaténer dans le module de classe)

Pour JOZZ
avec ton fichier et
'***********On vide le ControlTipText (info bulle au passage de la souris >>> 'Vin arrivé à terme')
'Me.Controls("TextBox" & CompteurDeLigneModifié & CompteurDeColonneModifié).ControlTipText = Empty
'***********

Essayes de déplacer un vin arrivé à terme, et tu constateras que le controle tiptex s'est bien effacé sur l'ancienne cellule mais ne s'est pas transférer sur la nouvelle: il faut donc bien modifier le module de classe comme je l'ai fait.
Avec ta méthode pour que cela fonctionne il faut que tu désélectionnes l'option button déplacer et que tu sélectionnes a nouveau visualiser !

Webperegrino · 9 Juillet 2020

Le Forum,
BonjourJM27,
Merci pour la découverte du fichier CAVE A VINS que vous m'avez adapté hier sur une autre conversation, pour permettre un fonctionnement sous Excel 2016 - 64 Bits.
J'interviens ici pour signaler une proposition d'amélioration de votre fichier.
En effet j'ai commencé, avec succès, d'appliquer votre fichier à ma cave :
Zones de 5 colonnes et 10 rangées pour ranger des bouteilles (Zone A : 50 cases de bouteilles à l'unité, puis idem pour Zones B à E).
Et le rangement se fait très bien dans l'application (je ne viens que commencer ma classification, j'aurai enfin de l'ordre dans le rangement).
Proposition (que je vais essayer de réaliser moi-même dans le VBA, si c'est possible) :
J'ai rangé 5 bouteilles de Champagne en 75 cl en Zone A - Rangée 1 - col 1 à A5
Ensuite 4 bouteilles de Champagne en 37,5 cl sont placées A - Rangée 2 - col 1 à A4
Il y a donc un changement de volume de bouteille qu'il serait bon de connaître à la consultation des Zones A à E.
. Un survol sur les cases pour faire apparaître le vin serait super (il faut actuellement cliquer pour voir le contenu et non faire apparaître l'info par simple survol sur une des cases du schéma déjà super clair - Bravo pour la conception -
. Dans l'Userform "Prélever un vin" ce serait super de voir après "Cote" qui est à droite de voir une colonne montrant le Format de bouteille (Bouteille de 75cl pour ma première ligne, et Bouteille de 37,5 cl pour ma deuxième ligne, puisqu'il s'agit du même produit).
Je précise que ce serait un "TOP supplémentaire" à votre géniale réalisation déjà parfaite pour mon modeste usage.
Bien cordialement,
Webperegrino

JM27 · 9 Juillet 2020

Bonsoir
Merci pour ton appréciation.
le survol : pas de pb , fonctionne déjà avec les vins arrivé à terme ( année maxi de consommation = date de l'année en cours)
On peut donc le faire en changeant l’événement dans le module de classe.
Quand à faire apparaître le contenant dans la list box , il y un pb de nombre de colonne maxi . attention il y a une colonne masqué avec une clé.
Il va falloir faire un choix et supprimer une donnée moins importante .

Webperegrino · 9 Juillet 2020

Le Forum,
Bonsoir JM27,
Oui, il est vraiment bien fabriqué ce fichier, il me rendra un grand service.
Merci pour ces dernières explications : je vais être prudent et resterai probablement sur la version en cours.
Nombre de colonnes maxi dans une Listbox : je comprends maintenant, grâce à vous, pourquoi je n'arrivais pas à ajouter une colonne de plus dans une listbox d'une de mes applications !
Bonne soirée,
Webperegrino

JM27 · 10 Juillet 2020

Bonjour
une solution répondant partiellement à tes besoins

Webperegrino · 10 Juillet 2020

Bonjour Jean-Marcel,
Merci à nouveau : je vais étudier cette dernière mouture dès que possible (un peu débordé ces jours-ci).
On apprend tous les jours avec ce partage de connaissances.
Cordialement,
Webperegrino

Webperegrino · 10 Juillet 2020

Jean-Marcel, c'est parfait.
Je regarde les codes complémentaires donnant la capacité de la bouteille consultée dans les prochains jours, merci.
Webperegrino

Cave à vins ( avec macro) 2018-03-08

Toubabou

XLDnaute Impliqué

JOZZ

XLDnaute Junior

Toubabou

XLDnaute Impliqué

Pièces jointes

JM27

XLDnaute Barbatruc

Pièces jointes

JM27

XLDnaute Barbatruc

Pièces jointes

Toubabou

XLDnaute Impliqué

JOZZ

XLDnaute Junior

Toubabou

XLDnaute Impliqué

JM27

XLDnaute Barbatruc

Pièces jointes

Webperegrino

XLDnaute Impliqué

JM27

XLDnaute Barbatruc

Webperegrino

XLDnaute Impliqué

JM27

XLDnaute Barbatruc

Pièces jointes

Webperegrino

XLDnaute Impliqué

Webperegrino

XLDnaute Impliqué

Discussions similaires