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

[Webperegrino]

Le Forum, Jean-Marcel, Jean-Marie,
Merci pour ces dernières recommandations,
Cordialement,
Webperegrino

 

[Toubabou]

Bonsoir à vous deux,
Juste une petite remarque, j'ai un bug lorsque je clique sur:
- Haut Droit
- Haut Gauche
- Bas Droit
- Bas Gauche
- Centre

Bonne soirée à vous.
Toubabou

 

[JM27]

Bonsoir
Mettre des boutons d'accès au feuilles: pas très bien.( j'en suis pas l'auteur 😀 )
J'en veux pour preuve que quand tu fais une RAZ , ru supprimes les feuilles , mais pas les macros qui donnent l'accès à celles ci à celles ci.
Pour t'en sortir dans des boutons d'accès aux onglets
Avec un on error resume next
modifier les macros comme cela

Sub HAUTgauche()
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.GoTo reference:=Sheets("HAUT Gauche").Range("A1"), Scroll:=True
    [A1].Select
End Sub

Sub HAUTdroite()
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.GoTo reference:=Sheets("HAUT Droite").Range("A1"), Scroll:=True
    [A1].Select
End Sub

Sub BASgauche()
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.GoTo reference:=Sheets("BAS Gauche").Range("A1"), Scroll:=True
    [A1].Select
End Sub

Sub BASdroite()
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.GoTo reference:=Sheets("BAS Droite").Range("A1"), Scroll:=True
    [A1].Select
End Sub

Sub CENTRE()
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.GoTo reference:=Sheets("CENTRE").Range("A1"), Scroll:=True
    [A1].Select
End Sub

 

[Webperegrino]

Le Forum, Jean-Marcel, Jean-Marie,
- #123 : bien vu Jean-Marcel !
- Toubalou :
1 - Dans Feuille MENU j'ai déverrouillé la cellule A1 :
(Feuille MENU, A1 sélectionnée - Accueil - Format - Format Cellule - ôter la coche 'Verroullé'
2 - Il arrivait que ça bugue en cliquant sur le bouton VISUALISER MA CAVE :
J'ai modifié le codage dans ModuleTraitement (Code) de la façon suivante :

Sub AfficherCave()
On Error Resume Next
SupprimerLesFiltres
If Sheets("Déroulants").Range("J2") = "" Then
  MsgBox "Pas de casiers créés", vbInformation, "AUCUN CASIER"
  Exit Sub
End If
If Sheets("Localisation").Range("A2") = "" Then
  MsgBox "Cave vide", vbExclamation, "CAVE A CRÉER"
  Exit Sub
End If
Application.ScreenUpdating = False
UserFormCasier.Show
RafraichirTCD
Application.GoTo reference:=Sheets("Menu").Range("A1"), Scroll:=True
On Error GoTo 0
End Sub

Je ne sais pas si Jean-Marcel sera content, mais j'ai constaté que ça ne bugue plus ainsi chez moi.
Cordialement,
Webperegrino

 

[JM27]

Bonjour
ca bug plus ; mais cela ne fait pas tout le travail que cette macro doit faire 😉
Crois tu qu'il faut mettre une gestion d'erreurs non maîtrisée que de résoudre véritablement le PB
Mettre un on error resume next en début de procédure et l'enlever à la fin n'est pas du tout bon , mais c'est toi qui vois , moi je e le ferais pas : il faut dire la ligne qui bug et voir pourquoi cela bug.
pour les boutons d'accès au feuilles casier , je précise qu'il y a un userform qui le fais en prenant en compte les feuilles existantes.

 

[Webperegrino]

Bonjour Jean-Michel,
Vous avez raison.
Je fais marche arrière et je reviens à une présentation et un accès plus simple en respectant tous les points énoncés au #125.
Je corrige l'application dans ce sens.
Merci beaucoup pour cette formation,
Webperegrino

 

[Toubabou]

Bonjour à vous deux,
Mon gendre me demandait ce matin:
- Comment faire dans le cas ou comme lui il possède une cave réfrigérer dans laquelle se trouve des étagères à deux rangées ?
- Il a un ordinateur en 32 bytes. Je crois qu'il faut modifier quelque chose au démarrage pour éviter qu'il bugg?
- Comment fait-on pour renommer un casier déjà existant
Merci à vous, bonne journée.
Jean-Marie

 

[Webperegrino]

Le Forum,
Bonjour Jean-Marie,
Si vous rencontrez ceci, pour fonctionner en 32 bits tant qu'en 64 bits ...
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
… mettez plutôt :

#If VBA7 Then
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

J’ai vu que pour les API il faut ceci :

#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Cordialement,
Webperegrino

 

[JM27]

Bonjour

Pour avoir la compatibilité 32 bytes

module paste picture
et supprimer PtrSafe

Pour avoir la modificcation du nomdu casier , ce n'était pas prévu , maintenant Ca l'est.
Pour avoir une étagère à deux rangées pour un emplacement : ce n'est pas prévu , il faudrait un casier à 3 dimensions ( ligne , colonnes et profondeur) : difficile mais pas impossible

 

[Webperegrino]

Le Forum,
... de plus j'ai modifié mon aperçu de casier en ceci (.JPG), avec la codification suivante plus complète (position de la date du vin, et terminé par accompagnements mets) :

Sub GestionDesFeuillesCasiers()
   ...
                For Each cellule In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                    ...
                      .Cells(cellule.Offset(0, 10) + 3, cellule.Offset(0, 11) + 1) = _
                                cellule & Chr(10) & _
                                cellule.Offset(0, 1) & " - " & cellule.Offset(0, 3) & " de " & cellule.Offset(0, 4) & Chr(10) & _
                                cellule.Offset(0, 2) & Chr(10) & _
                                "Acheteur : " & cellule.Offset(0, 19) & Chr(10) & _
                                "Cote : " & cellule.Offset(0, 20) & Chr(10) & _
                                cellule.Offset(0, 23) & " - DLC : " & cellule.Offset(0, 6) & Chr(10) & _
                                cellule.Offset(0, 14)
                       ...
                    End With

Webperegrino

 

[JM27]

Bonjour
avec gestion d'erreur au cas ou on nomme un casier pas accepté par excel
@Webperegrino
Regardes l'utilité d'un on error resume next dans ce cas

 

[JM27]

Petit rectif
variable non déclarée

 

[Webperegrino]

Bonjour,
Merci Jean-Marcel.
Webperegrino

 

[Toubabou]

Merci Jean-Marcel
Jean-Marie

 

[Toubabou]

Le Forum,
... de plus j'ai modifié mon aperçu de casier en ceci (.JPG), avec la codification suivante plus complète (position de la date du vin, et terminé par accompagnements mets) :

Sub GestionDesFeuillesCasiers()
   ...
                For Each cellule In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                    ...
                      .Cells(cellule.Offset(0, 10) + 3, cellule.Offset(0, 11) + 1) = _
                                cellule & Chr(10) & _
                                cellule.Offset(0, 1) & " - " & cellule.Offset(0, 3) & " de " & cellule.Offset(0, 4) & Chr(10) & _
                                cellule.Offset(0, 2) & Chr(10) & _
                                "Acheteur : " & cellule.Offset(0, 19) & Chr(10) & _
                                "Cote : " & cellule.Offset(0, 20) & Chr(10) & _
                                cellule.Offset(0, 23) & " - DLC : " & cellule.Offset(0, 6) & Chr(10) & _
                                cellule.Offset(0, 14)
                       ...
                    End With

Webperegrino

Bonjour Webperegrino, Bonjour JM27,
J'ai un petit soucis après avoir appliquer le code i-dessus. Je n'arrive plus redimensionner la photo de ma bouteille de vin. Avez-vous une idée?
Merci à vous deux
Jean-Marie