XL 2019 Couleurs d'un rectangle

[crazyguismo]

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

 

[patricktoulon]

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

 

[patricktoulon]

en fait ceci ne fonctionne pas comme je l'ai imaginé.
ce code change bien le fond sur la feuille 8 mais seulement sur la feuille 8, j'aimerai que cela change sur toutes les feuilles.

combien de fois devront nous te le répéter il n'y a pas de shapes ("nav") dans les autres sheets

 

[crazyguismo]

je suis désoler mais même avec d'autres shape ("nav") dans les autres sheets cela ne fonctionne pas.

 

[patricktoulon]

j'ai tres bien compris ce que tu essai de faire
tu voudrais le meme bandeau en haut sur chaque feuille
dans ce cas la fourni un exemple correspondant a la demande

 

[patricktoulon]

je suis désoler mais même avec d'autres shape ("nav") dans les autres sheets cela ne fonctionne pas.

oulalahh
ben c'est normal comme il n'y avait pas je n'ai pas pris cette considération
moi c'est le lundi qui est dur pour d'autre visiblement c'est le mercredi

 

[patricktoulon]

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

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

 

[crazyguismo]

Merci pour ta réponse.
J'ai en effet trouver pourquoi le fichier est endommagé, de plus j'ai réussi a faire ce que je voulais.

Mais peux tu me dire pourquoi tu trouve que le fichier est mal fait?

 

[patricktoulon]

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

 

[crazyguismo]

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.

 

[patricktoulon]

re

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

 

[crazyguismo]

merci beaucoup je n'en demandais pas autant.

je commence dans la programmation vba , je ne maitrise pas encore tout les textes.

 

[crazyguismo]

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]

re
bonjour

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

 

[crazyguismo]

Merci, ok je vois ce que tu a

 

[crazyguismo]

ce que tu as fait, en revanche cela ne fonctionne pas, la compilation est impossible, excel me marque

erreur de compilation
Next sans for

alors que tu as marquer for et next.