Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Couleurs d'un rectangle

crazyguismo

XLDnaute Nouveau
Bonjour la communauté,

Voila je bute sur un sujet, je suis en train de réaliser une gestion de stock automatiséé.
Il ne me reste plus qu'à faire des remplacements de couleur sur la page congif (pour le moment je ne travail que sur cette feuille)
Je vous joins le fichier.

Mon but est de changer la couleur du rectangle nommé "nav" en cliquant sur la couleur souhaiter. (module couleurs_fond)
dans un deuxième temps j'aimerai faire un contour sur ces rectangle couleur. (module couleurs_page)

lors du débogage la ligne

For Page_menu = 1 To 8
Sheets(Page_menu).Shapes("nav").Fill.forcolor.RGB = RGB(0, 0, 0)
Next Page_menu

pouvez-vous m'aider?

merci
 

Pièces jointes

  • gestion du stock.xlsm
    190.6 KB · Affichages: 6

patricktoulon

XLDnaute Barbatruc
Merci ca a l'air de fonctionné correctement.
merci, peux-tu me dire ce qui n'aller pas dans la première macro?

rien n'allait tu va chercher des shap dans les autre sheets et qui n'existent pas alors que tu veux
en plus une sub pour chaque bouton mais la on en fini plus
travailler sur config
pour la peine j'ai TOUT VIRER!!!!!! (codes et module )
je te l'ai refait au propre un seul module et 3 sub
couleur de fond1 pour nav
couleur de fond pour les bouton page

selection de sheets pour les bouton page
et c'est tout
propre et net
 

Pièces jointes

  • gestion du stock V pat .xlsm
    166.4 KB · Affichages: 4

patricktoulon

XLDnaute Barbatruc
re
en plus
le fichier a des references circulaire
il est endomagé
bref tu es au debut du chemin et t'a deja peter la courroie de distribution

ALORS§
copie ton bandeau tel quel sur toutes tes feuilles
et le module
VB:
Option Explicit
'une meme sub pour tout les bouton couleur pour fond("nav") dans toutes les feuilles
Sub couleurs_fond1()
    Dim Couleur&, I&, sh
    Couleur = ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
    For Each sh In Worksheets
        sh.Shapes("nav").Fill.ForeColor.RGB = (Couleur)
    Next
    For I = 1 To 5
        ActiveSheet.Shapes("bccolor" & I).Line.Visible = False
    Next
    With ActiveSheet.Shapes(Application.Caller): .Line.Visible = True: .Line.ForeColor.RGB = vbRed: End With
End Sub

'une meme sub pour tout les bouton couleur_page dans toutes les feuilles
Sub couleurs_page1()
    Dim Couleur&, shap, I&, sh
    Couleur = ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
    For Each sh In Worksheets
        For Each shap In sh.Shapes
            If Left(shap.Name, 4) = "page" Then shap.Fill.ForeColor.RGB = (Couleur)
        Next
    Next
    For I = 1 To 5
        ActiveSheet.Shapes("color" & I).Line.Visible = False
    Next
    With ActiveSheet.Shapes(Application.Caller): .Line.Visible = True: .Line.Weight = 3: .Line.ForeColor.RGB = vbRed: End With
End Sub

'une meme sub pour tout les boutons page dans toutes les feuilles
Sub page_select()
    Sheets(Val(Replace(Application.Caller, "page", ""))).Select
End Sub

perso j’arrête la car ton fichier est trop mal fait
cela dit tu a ta réponse maintenant
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour
c’était tes codes qui etait trop mal fait et tes rubans de carrés qui manquaient dans les autres feuilles
a tu essayé le mien au moins ?
c'est a dire virer tout code et mettre uniquement le mien tu aurais constater que je t'ai fait le boutot dans sa globalité

je réitère donc ce que je te dis en post 21
faut t il que je te le fasse ?

ton fichier est mal fait
j'explique
des le depart boom reference circulaire


ensuite un bouton bccolor2 dans la ligne de bouton page qui n'a rien a foutre la

suite
tu veux l'enregistrer ben walouh!! par ce que .....

ben une image parle bien mieux que des mots


bref le fichier est pourri
et j’arrête la car je suis sur de trouver encore des anomalies
je t'ai fait un code il fonctionne très bien

tiens je te le livre avec tes erreurs mais les boutons fonctionnels
 

Pièces jointes

  • gestion du stock (2).xlsm
    181.6 KB · Affichages: 5
Dernière édition:

crazyguismo

XLDnaute Nouveau
je suis assez surpris, je n'ai vraiment aucun problème à enregistrer.
J'ai trouver en effet la réfrence croisée.

Mais le reste me semble correct.

peux tu me dire si il est possible lorsque l'on click sur un bouton de mettre des conditions si certaines shapes sont vides d'afficher un message d'erreur.

Private Sub CommandButton1_Click()
If Sheets(2).Shapes("case1") = "" Then
MsgBox "Attention il manque des informations ? renseign?s"
End If
End Sub

voici mon code.
 

crazyguismo

XLDnaute Nouveau
Bonjour
Désolé de demander cela, mais je suis a nouveau bloquer, j'aimerai enregistrer un pdf mais que sur certaines conditions.

par exemple si certaines cases ne sont pas remplies impossible d'imprimer en PDF.
J'ai déja écris le code mais il ne me reste plus que cela à faire et je ne trouve pas.

peux-tu m'aiguillés?

Private Sub CommandButton1_Click()
If Sheets(2).Shapes("case1").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case2").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case3").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case4").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case5").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case6").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case7").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case8").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case9").TextFrame.Characters.Text = "" Or _
Sheets(2).Shapes("case10").TextFrame.Characters.Text = "" Then

MsgBox "Attention il manque des informations à renseignées!!"

'créer un PDF
Dim Ledossier As String, Leclient As String, lerep As String
Ledossier = Range("B4").Value
lerep = "chemin" & "\" & [B4] & "\" ' à adapter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
lerep & "_" & Ledossier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
from:=1, To:=1, OpenAfterPublish:=True

End If
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
bonjour
VB:
Private Sub CommandButton1_Click()
For i = 1 To 10
If Sheets(2).Shapes("case" & i).TextFrame.Characters.Text = "" Then
MsgBox "Attention il manque des informations à renseignées!!": Exit Sub
Next
'créer un PDF
Dim Ledossier As String, Leclient As String, lerep As String
Ledossier = Range("B4").Value
lerep = "chemin" & "\" & [B4] & "\" ' à adapter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
lerep & "_" & Ledossier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
from:=1, to:=1, OpenAfterPublish:=True

End If
End Sub
 

Discussions similaires

Réponses
7
Affichages
626
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…