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