Decalage de selection

Bonjour à tous.

Il me reste un dernier problème sur une macro en cours de développement :

Via une fonction de rechercher personnalisée (@RechercheX), j'ai un résultat qui s'affiche dans une cellule.

Le but de cette partie de code est de modifier la taille de la police dans la cellule contenant le résultat en fonction du nombre de caractères du résultat.

'+---------------------------------------------+
' RECHERCHE X NOM DU PROGRAMME DE DECOUPE LASER
'+---------------------------------------------+

'Variables liées à la plage PROGRAMME LASER
Public ColProg As String 'Plage de correspondance(colonne nommée)
Public Root_Prog As String 'Chemin complet de cette plage
Public Prog As String 'Désignation de la valeur du résultat

'Fonction de rechercheX personnalisée
Function SearchProg(Reference As String) As Variant
'Récupération du nom de la colonne de recherche du TABLEAU (ici nommé BDD)
ColProg = "BDD[Programme]"
'Récupération du nom complet de la colonne de recherche du TABLEAU (ici nommé BDD)
Root_Prog = "'" & Dbname & "'" & "!" & ColProg
'Gestion des erreurs
    On Error Resume Next
'Recherche d'une correspondance à la référence dans une colonne nommée d'un tableau
Prog = Application.WorksheetFunction.XLookup(Reference, Range(Root_Ref), Range(Root_Prog))
'Gestion de l'erreur de non correspondance
If Prog = "" Then
    SearchProg = " ? "
        Else
    SearchProg = Prog
    End If
If (Len(Prog) > 30) Then
ActiveCell.Offset(0, 1).Select
            Else
Selection.Offset(0, 3).Select
   End If
On Error GoTo 0
End Function

Lorsque je tape la référence de ma pièce dans les cellules grises ex: I1, toutes les données sont extraite et mise en forme au format d'étiquette AVERY.

J'ai essayé la méthodes Find (retrouver la cellule contenant le résultat) mais cela ne marche pas car dans la cellule est inscrit ma fonction "=@ShearchProg(I4)", pas le résultat de calcul.

Comme l'utilisateur doit sélectionner la cellule pour entrer sa valeur je me suis dit que j’allais utiliser un décalage de sélection et changer la taille de police de la nouvelle sélection. De I1 on se décale en I4. Mais je ne trouve pas la solution.

Dans la cellule I8 le nombre de caractères excédant pas 30, la taille de police ne doit pas changer. Par contre sur les cellules C4,I4 et C8 je souhaiterais que la police passe à 10 au lieu de 14 afin d'avoir les 2 noms de programmes sur 2 lignes lisibles.

Quelqu'un peut il m'aider ?

Bonjour,

Ce qu'il faut, c'est une macro évènementielle qui réagira au changement de valeurs de la cellule C1 ou I1 et qui vérifiera les cellules C4, C8, I4, I8

Macro à copier dans le module de la feuille;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Not Intersect(Target, Range("C1,C5,I1,I5")) Is Nothing Then
        For i = 4 To 8 Step 4
            For j = 3 To 9 Step 6
                If Len(Cells(i, j)) > 30 Then
                    Cells(i, j).Font.Size = 10
                Else
                    Cells(i, j).Font.Size = 14
                End If
            Next j
        Next i
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Cdlt

Bonsoir. Je suis plutôt novice en VBA en ce qui concerne des "Private Sub"

Si elle est privée, elle ne s’exécute que dans le module où se trouve déjà mon code?

Je l'ai mis dans mon code mais cela ne fonctionne pas

Coucou.

Pourrais tu m'expliquer pourquoi le code suivant fonctionne quand je suis dans une procédure Sub

Sub decalage()
ActiveCell.Offset(2, -3).Activate 'colonne,ligne
ActiveCell.Interior.Color = RGB(192, 0, 0)
End Sub

Alors que lorsque je copie exactement la même chose à l'intérieur de ma fonction (Function SearchProg), cela ne fonctionne plus ?

Voici un extrait de la base de données, le ficher utilisateur, le répertoire d'images tests et la structure des fichiers

Il faudra surement changer les paramètres de localisation des fichiers chez vous pour que cela fonctionne.

Pour faire court, le bureau indus va alimenter une base de données récapitulant toutes les informations utiles pour différents services. Chaque service aura un fichier Excel qui ira se servir dans cette base de données.

Le fichier joint servira par exemple à créer et mettre à jour les étiquettes de kanban pour le stock de pièces semi-finie. Mais j'en ai d'autres : Fiche de poste de préparation soudure, fiche de poste pièces modèles ...

Si j'arrive à trouver le moyen de modifier l'apparence d'une cellule en prenant en référence la case grise où est tapé la référence, j'aurais tout gagné. Mais pour l'instant je sèche. Cela fait 4 jours que je passe sur les différents forums et je ne trouve rien en exemple d'Activecell offset à l'intérieur d'une fonction. A chaque fois c'est dans une procédure sub.

Bonjour,

Gros problème pour moi, vous avez la version 365 alors que moi, j'en suis encore à excel 2007, donc vos formules ne sont pas lisibles chez moi. voici ce que je voie:

_xlfn.SINGLE n'existe pas chez moi, et elle s'écrirait: =SI(C1="";"";SearchProg(C1)), en la modifiant, et en l'activant en la validant dans la barre de formule, ça bloque ici:

"ColProg = "BDD[Programme]" donc question: Où est ce tableau BDD?, je le trouve dans l'autre fichier "organisation...", mais alors quel est le lien qui relie ces 2 classeurs?

En continuant mes investigations, sous la fonction précédente, je vois la macro "Private Sub Worksheet_Change(ByVal Target As Range)" qui, étant une macro évènementielle devrait se trouver dans le module de la feuille dont elle dépend et non dans un module standard. Donc dans le cas présent, la macro doit être dans le module de la feuille "Stickers".

Vous écrivez "Je suis plutôt novice en VBA en ce qui concerne des "Private Sub"" , mais le langage et la syntaxe du code sont identiques. à la différence près, c'est que pour la cellule sélectionnée, dans un module standard, on utilise "ActiveCell" alors que c'est "Target" dans le module de la feuille.

Vous vous dites "Novice" mais vous ne commencez pas par la simplicité. Je pense qu'avant de vouloir faire des macros et des fonctions personnalisées, il serait préférable de réorganiser entièrement votre façon de procéder. A votre place, je commencerai par ne faire qu'un seul classeur qui réunirait "organisation ..." et "Etiquette....", histoire de se simplifier la tâche.

Cdlt

Bonsoir,

Tous d'abord merci du temps que vous m'accordez afin de résoudre mon problème. Ensuite vous avez raison. Je suis en Excel 365.

Les formules dans ma barre de formule sont bien toutes sous la forme : =SI(C1="";"";SearchProg(C1))

Le lien qui relie ce fichier est la base de données se trouve dans la macro via les variables : "Data_base" , "Dbname" , "Root_Ref" et Mytable = "BDD[".

BDD est le nom du tableau dynamique qui se trouve dans "organisation_de_fabrication_test.xlsm" (pas tableau croisé dynamique). Grace à ce format de tableau je récupère des noms de colonne (avec des n° de colonnes c'était moins pratique pour coder en quand de retrait ou d'insertion).

Mon code revient à réaliser des rechercheX dans une base de données externe.

Après avoir placé le code de la private sub dans la feuill stickers cela fonctionne.

J'ai un dernier changement au cahier des charges de cette macro. Il faudrait que les fonds de certaines cellules changent de couleur en fonction des values quelles renvoient. J'ai essayé comme vous avez pu le constater dans différents modules : exemple module Ecrous, essais, module 2...

Lorsque c'est dans une sub ,donc public, La couleur de fond change. Lorsque je met le même code dans une fonction, malgrès un offset, la cellule où se trouve la référence reste la cellule active. De quoi cela peut il venir ?

Sub Change_color
Dim MyBook As Workbook
Set MyBook = ActiveWorkbook
MsgBox (MyBook.Name)

Dim MySheet As Worksheet
Set MySheet = ActiveSheet
MsgBox (MySheet.Name)

Dim MyCellRef As Range
Set MyCellRef = ActiveCell
MsgBox (ActiveCell.Address)

MyCellTarget.Offset(3, 2).Select
MsgBox (Selection.Address)
Selection.Interior.Color = 12611584
End sub

Pour ce qui est du fait de simplifier le travail, je ne peux pas faire mieux au vue de mes compétences en VBA malheureusement. Si je ne travaille pas avec tout dans le même fichier, c'est que les utilisateurs m'ont demandé de pouvoir réaliser des étiquettes, des fiches de poste de soudure ou des fiches de poste de pièces modèles même si une 4ème personne est en train d'ajouter des lignes dans la base de données.

Bonjour,

Je ne trouve pas la commande de changement de couleur dans la fonction "SearchProg"

Function SearchProg(Reference As String) As Variant

    'Variables liées à la plage PROGRAMME LASER
    Dim ColProg As String 'Plage de correspondance(colonne nommée)
    Dim Root_Prog As String 'Chemin complet de cette plage
    Dim Prog As String 'Désignation de la valeur du résultat

    'Récupération du nom de la colonne de recherche du TABLEAU (ici nommé BDD)
    ColProg = "BDD[Programme]"
    'Récupération du nom complet de la colonne de recherche du TABLEAU (ici nommé BDD)
    Root_Prog = "'" & Dbname & "'" & "!" & ColProg
    'Gestion des erreurs
    On Error Resume Next
    'Recherche d'une correspondance à la référence dans une colonne nommée d'un tableau
    Prog = Application.WorksheetFunction.XLookup(Reference, Range(Root_Ref), Range(Root_Prog))
    'Gestion de l'erreur de non correspondance
    If Prog = "" Then
        SearchProg = " ? "
    Else
        SearchProg = Prog
    End If
    'Worksheet_Change
    On Error GoTo 0
End Function

Ensuite, pourquoi passer par une fonction pour changer la couleur? une Mise en Forme Conditionnelle ne ferait-elle pas l'affaire?

Cdlt

Bonjour.

Concernant le code pour le changement de couleur je l'avais mis dans une autre version mais c'est bien celui mentionné plus haut :

Dim MyBook As Workbook
Set MyBook = ActiveWorkbook
MsgBox (MyBook.Name)

Dim MySheet As Worksheet
Set MySheet = ActiveSheet
MsgBox (MySheet.Name)

Dim MyCellRef As Range
Set MyCellRef = ActiveCell
MsgBox (ActiveCell.Address)

MyCellTarget.Offset(3, 2).Select
MsgBox (Selection.Address)
Selection.Interior.Color = 12611584

L'idée de base est d'utiliser la sélection courante (l'utilisateur tape forcément la référence dans la case grise) et de l'utiliser comme point de départ pour faire des offsets afin de sélectionner/activer une autre cellule. Une fois cette dernière activée, il ne reste plus qu'a lui changer sa couleur de font (interior.color) . En plus, je peux choisir en fonction de la valeur que prend la cellule. Dans le fichier d'étiquettes sans macro, les opérateur avaient tellement bidouillé que le changement de couleur par MFC ne fonctionnait plus (suite à des copié-collés venant d'autres fichiers). Si tu pouvais m'aider sur ce dernier point ce serait super. En exemple, dans le module "Écrous", le code permettrait de remplir la cellule en bleu quand écrou est valorisé dedans ou orange quand c'est "tarau. J'ai essayé différentes solutions mais mon offset ne marche pas. Quoi que je code dans la fonction, il pointe toujours sur la cellule référence (grise) Msgbox active cell ou selection et me renvoi $C$2 ou $I$2 .... Un exemple qui fonctionne pour écrou me suffira pour réaliser les autres couleurs conditionnées aux valeurs des cellules pour chaque module.