Récupérer la couleur d'une case excel, pour l'appliquer lors d'une mise en forme
Bonjour à tous,
Tout d'abord, je suis un pur débutant dans VBA excel et je n'ai que quelques notions de programmation générale.
Je souhaites améliorer une macro créer par un tiers, afin de me faciliter la vie.
Je dispose d'une feuille "données" et d'une feuille dans laquelle est mis en forme les informations contenues dans la feuille "données".
Pour cela, je clique sur un bouton dans la feuille " données" paramétré pour lancer une macro VBA, qui met l'ensemble des données en forme dans la deuxième feuille donc.
Actuellement, la couleur utilisé pour formaté les cases d'une ligne dans la deuxième feuille (le résultat de la mise en forme) est fixée(bleu), je souhaiterai récuperer la couleur du fond de la cellule utilisée (ciblé en gris, si j'ai bien compris) pour l'appliquée lors de la mise en forme, à la place de la couleur fixée (RGB(200, 200, 200))
La parti en orange est un de mes essais, non concluant, dans laquelle vous allez sans doute pour certain, voir mon newbeeisme dans la matière :-)
Code:
1 2 3 4 5 6 7 8 9
| With Worksheets(PMpav).Shapes.AddShape(msoShapeRectangle, xpav(numtypeop%, codop, nbmvt%), ypav(numtypeop%, codop, nbmvt%) + hauteur_tâche%, durée_mvt(numtypeop%, codop, nbmvt%) * Echellex, hauteur_autres%)
.TextFrame.Characters.Text = Worksheets(PMdon).Cells(rm, cl_instruction%).Value
.TextFrame.Characters.Font.Bold = True
.Fill.ForeColor.RGB = RGB(200, 200, 200)
'.Fill.Interior.ColorIndex = Worksheets(PMdon).Cells(rm, cl_instruction%).Interior.ColorIndex
.TextFrame.Characters.Font.Size = 10
.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter |
J'espère avoir été assez clair,
N'hésitez à me poser des questions bien entendu,
D'avance, je remercie les lecteurs et peut être sauveur, de ce post,
Rémi
ça à l'air de fonctionné...
... en tout cas c'est le principe que je veux appliquer!
Tout d'abord, merci de t'intéresser à mon soucis :-)
J'ai essayé d'adapter le code que tu m'as gracieusement formulé et qui fonctionne sur une page excel de test, au code présent dans mon fichier excel:
Voici les modifs:
Début (variables):
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
Sub liss_charges()
Dim num_mvt(12, 20, 50)
Dim durée_mvt(12, 20, 50) As Single
Dim durée_cpr(12, 20, 50) As Single
Dim durée_met(12, 20, 50) As Single
Dim xpav(12, 20, 50) As Integer
Dim ypav(12, 20, 50) As Integer
Dim npavs As Long
Dim PMdon As Integer 'feuille avec données
Dim PMpav As Integer ' feuille avec pavés
Dim Echellex As Integer 'facteur echelle en x
Dim Echelley As Integer 'facteur echelle en y
Dim Tbl() As Long
cl_tâche% = 1
cl_durée_mét% = 2
cl_correct_prod% = 3
cl_num_op% = 4
cl_autre_poste% = 6
cl_num_tâche% = 13
cl_instruction% = 5
cl_FI_contrôle% = 7
cl_NumCond% = 10
cl_heuresparpage = 12
hauteur_tâche% = 84
hauteur_autres% = 18
PMpav = 0
PMdon = 0
Nbop = 0
Nombre_op = 0
numtypeop% = 1
nbmvt% = 1
cadence% = 0
Echelley% = 165
rm = 3: CM = 1:
PMdon = ActiveSheet.Index
Application.ScreenUpdating = False
.... |
Ensuite la partie qui me concerne réellement:
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
| If codop <> 0 Then
'ajout du pavé instruction de la tâche
With Worksheets(PMpav).Shapes.AddShape(msoShapeRectangle, xpav(numtypeop%, codop, nbmvt%), ypav(numtypeop%, codop, nbmvt%) + hauteur_tâche%, durée_mvt(numtypeop%, codop, nbmvt%) * Echellex, hauteur_autres%)
.TextFrame.Characters.Text = Worksheets(PMdon).Cells(rm, cl_instruction%).Value
.TextFrame.Characters.Font.Bold = True
'.Fill.ForeColor.RGB = RGB(200, 200, 200)
.Tbl() = CouleurRVB(Cells(rm, cl_instruction%))
.Fill.ForeColor.RGB = RGB(Tbl(1), Tbl(2), Tbl(3))
.TextFrame.Characters.Font.Size = 10
.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter
If (durée_mvt(numtypeop%, codop, nbmvt%) * Echellex) < 48 Then
.TextFrame.Characters.Font.Size = 6
End If
.Select
For Z% = 1 To npavs
.ZOrder msoSendBackward
Next Z%
End With |
Et enfin, la fonction que j'ai ajouté après le End Sub de la partie précédente:
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
| Function CouleurRVB(Cel As Cells) As Long()
Dim TblCouleur(1 To 3) As Long
Dim Couleur As Long
Dim J As Long
Dim K As Long
Couleur = Cel.Interior.Color
K = 3
For J = 2 To 0 Step -1
TblCouleur(K) = Couleur \ 256 ^ J
Couleur = Couleur Mod 256 ^ J
K = K - 1
Next J
CouleurRVB = TblCouleur()
End Function |
Mais bien entendu, cela ne fonctionne pas (pas encore :-) ), et j'ai une erreur : "Type défini par l'utilisateur non défini" lors de l'exécution/débogage en me surlignant en bleu
Code:
Function CouleurRVB(Cel As Cells) As Long()
Si tu as/vous avez une idée...
D'avance, merci!
Rémi