[VBA EXCEL] - Importer une plage de valeur sans les formule et Mise en Forme Cellule

**ancel17** · 18/10/2007, 19h16

Bonsoir à tous !

Je voudrais savoir comment faire pour n'importer que les valeurs d'une plage de données mais pas les formules puis appliquer une Mise en Forme Conditionnelle sur la colonne c dépendant si la valeur de la cellule(l,c) est différente de la valeur de la cellule(l,c-1).

Merci de vos contribution !

**ouskel'n'or** · 18/10/2007, 21h18

Bonsoir Ancel,
Pour le principe puisque tu ne dis rien de ton fichier, noms des feuilles, adresses des cellules...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
    'Copie de la plage de données commençant en A1 et limitée aux
    premières ligne et colonne entièrement vides
    Worksheets("Feuil1").Range("A1").CurrentRegion.Copy
    'Collage des valeur et du format
    Sheets("Feuil4").Range("A1").PasteSpecial _
          Paste:=xlPasteValuesAndNumberFormats
 
    'suppression de la mise en forme conditionnelle... s'il en existe une
    Worksheets("feuil1").Range("D1").FormatConditions.Delete
    'Mise en forme conditionnelle sur la cellule D1 si C1 <>
    Worksheets("feuil1").Range("D1").FormatConditions.Add Type:=xlCellValue, _
        Operator:=xlNotEqual, Formula1:="=" & Range("D1").Offset(0, -1).Address
    'format de cellule désiré
    With Worksheets("feuil1").Range("D1").FormatConditions(1)
        With .Interior
            .ColorIndex = 28
        End With
    End With

Bonne soirée

**ancel17** · 18/10/2007, 22h44

Merci Ouskel'n'or !

je teste ça demain, et si cela ne fonctionne pas, je donnerai plus de détails !

A+

**ancel17** · 19/10/2007, 08h40

Bonjour,

après teste, ça ne fonctionne pas terrible...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
            Set FL12 = CL1.Worksheets("Récapitulatif")
            Set FL22 = CL2.Worksheets("Récapitulatif")
            Set Plage = FL22.Range("F6:J11")
            FL22.Activate
            If Nom = "Laboratoire - Gammagraphie" Then
                FL12.Range("F60:F65").Clear
                FL12.Range("H60").UnMerge
                Plage.Copy
                FL12.Range("F60").PasteSpecial (xlPasteValues)
            End If

pour info la plage H60:J11 de Plage est fusionnée d'où le .UnMerge, mais je reste avec l'erreur suivante :

Erreur d'exécution '1004' :

Cette opération requiert que les cellules fusionnées soient de taille identique.

**ouskel'n'or** · 19/10/2007, 09h18

Tu définis la plage que tu copies sur FL22... ok, mais tu appliques UnMerge à une seule cellule de FL12. tu es certain de n'avoir qu'une cellule fusionnée ?
Il est inutile d'instancier deux fois ta feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
       Dim FL1 as worksheet
       Dim plage as range
            Set FL1 = CL1.Worksheets("Récapitulatif")
            Set Plage = FL1.Range("F6:J11")
            FL1.Activate
            If Nom = "Laboratoire - Gammagraphie" Then
                FL1.Range("F60:F65").Clear
                FL1.Plage.UnMerge
                FL1.Plage.Copy
                FL1.Range("F60").PasteSpecial (xlPasteValues)
            End If

Tu peux tester ?
A+

**ancel17** · 19/10/2007, 16h12

Salut !

le fait est que j'ai deux classeurs différents et donc deux feuilles différentes... Mais ce n'est plus ce problème qui m'amène, je l'ai résolu et voici le code utilisé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Set CL1 = ThisWorkbook  'définition du classeur qui reçoit les données
Set FL11 = CL1.Worksheets("fonderie")
Set rep = fso.GetFolder(Application.ThisWorkbook.Path & "\Secteurs")
Set FL12 = CL1.Worksheets("Récapitulatif")
Set Plage1 = FL12.Range("F6:J65")
 
    With Plage1
        .Clear          'j'efface les données de la plage
        .UnMerge        'et retire défusionne les cellules qui le sont pour ne pas avoir de souci avec la dimension des cellules fusionnées !
    End With
 
    For Each secteur In rep.Files
        Wk = rep & "\" & secteur.Name
        If fso.GetExtensionName(Wk) = "xls" Then
            CL1.Save
            Set CL2 = Workbooks.Open(Wk)
            Nom = Left(secteur.Name, Len(secteur.Name) - 4)
 
            Set FL22 = CL2.Worksheets("Récapitulatif")  'définition de la feuille source des données (le classeur est définie avant dans une partie du code qui ne nous intéresse pas ici)
            Set Plage2 = FL22.Range("F6:J11")
 
            FL22.Activate
            FL22.Range("H6").UnMerge                    'je défusionne pour les même raisons que précédemment
            If Nom = "Bureaux" Then
                Plage2.Copy
                FL12.Range("F42").PasteSpecial (xlPasteValues)  'je colle où il faut
                FL12.Range("H42:J47").Merge             'je refusionne pour que ce soit beau
                FL12.Range("F42:J47").Borders(xlEdgeBottom).LineStyle = xlContinuous    'et je lui met des bordures
            ElseIf ...
                ...
            End If
            FL12.Range("H6:J65").WrapText = True    'renvoie automatique à la ligne, alignement des cellules
            FL12.Range("F6:G65").HorizontalAlignment = xlHAlignCenter
            FL12.Range("F6:J65").VerticalAlignment = xlVAlignCenter
            FL22.Range("H6:J11").Merge              'et refusion...
            FL22.Range("H6:J11").WrapText = True
 
            CL2.Close savechanges:=True
        End If
    Next
 
    With Plage1                                     'et rebordures et alignement
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With
 
    For Each c2 In FL12.Range("G6:G65").Cells   'MFC
        If Not c2 = c2.Offset(0, -1) Then
            c2.Font.ColorIndex = 3
        End If
    Next

Mon problème à présent est le suivant :
j'ai un texte concaténé dans une cellule de la manière suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FL11.Range("A" & premlig & ":" & "A" & derlig).Value = Nom & Chr(10) & Chr(10) & "Dernière mise à jour : " & FL21.Range("H1")

je voudrais que seule la partie "Dernière mise à jour : " & FL21.Range("H1") soit en "Normal Italic".
J'imagine qu'avec Characters() on doit s'en sortir, mais la longueur de mon texte total est variable et seule la longueur de la partie à mettre en "Normal Italic" est connue (34).

Une solution simple est basculé les deux parties pour avoir la partie "Normal Italic" devant, mais moi je la veux derrière...

**AlainTech** · 19/10/2007, 16h14

Envoyé par ouskel'n'or

Il est inutile d'instancier deux fois ta feuille

Tss, tss...
Encore lu trop vite?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set FL12 = CL1.Worksheets("Récapitulatif")
Set FL22 = CL2.Worksheets("Récapitulatif")

**ouskel'n'or** · 19/10/2007, 20h18

Salut Alain,
Et toi t'as pas tout lu !

Envoyé par ancel17 Aujourd'hui 08h40

Bonjour,

après teste, ça ne fonctionne pas terrible...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
            Set FL12 = CL1.Worksheets("Récapitulatif")
            Set FL22 = CL2.Worksheets("Récapitulatif")
            Set Plage = FL22.Range("F6:J11")
            FL22.Activate
            If Nom = "Laboratoire - Gammagraphie" Then
                FL12.Range("F60:F65").Clear
                FL12.Range("H60").UnMerge
                Plage.Copy
                FL12.Range("F60").PasteSpecial (xlPasteValues)
            End If

pour info la plage H60:J11 de Plage est fusionnée d'où le .UnMerge, mais je reste avec l'erreur suivante :

Tu en aurais déduit quoi ?

**AlainTech** · 21/10/2007, 15h03

Qu'il copie du classeur CL2 vers le classeur CL1

**ouskel'n'or** · 21/10/2007, 22h49

Envoyé par AlainTech

Qu'il copie du classeur CL2 vers le classeur CL1

Y'a que ceux qui ne font rien qui ne risquent pas de se tromper !

Hello ancel17,
Soyons constructifs, nous. Pour avoir la dernière partie, tu as vblf (chr(10)) comme repère
J'ai remplacé ta chaîne par la mienne mais le principe est le même

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Chaine = Nom & Chr(10) & Chr(10) & "Dernière mise à jour : " & FL21.Range("H1")
Chaine = "Chose" & Chr(10) & Chr(10) & "Dernière mise à jour : " & "Un autre texte"
Result = Mid(Chaine, InStr(Chaine, vbLf) + 2, Len(Chaine) - InStr(Chaine, vbLf) + 2)
'FL11.Range("A" & premlig & ":" & "A" & derlig).Value = Result
MsgBox Result

Tu sauras adapter ?

**ancel17** · 22/10/2007, 11h29

Bonjour Ouskel'n'or

Tout d'abord, merci de ton aide !

Passons à mon problème.
il me semble que Mid() s'applique à une chaine de caractère et pas à un objet Range.
Du coup, j'agit sur la chaine avant de l'envoyer dans la cellule, mais après la mise en forme reste celle de la cellule, et je ne peux pas avoir deux mise en forme différente dans la même cellule... mais je me trompe peut-être ?

**ouskel'n'or** · 22/10/2007, 13h36

Je t'ai donné principe pour trouver la fin de ta chaîne, pas pour que tu colles cette fin telle quelle.
Ensuite tu ne peux appliquer un format sur une partie de cellule pour une plage. La mise en forme ne peut se faire que cellule par cellule.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
Dim Chaine$, PremLig%, DerLig%, Ch1$, ch2$, lch1%, lch2%
    PremLig = 1
    DerLig = 10
    'Chaine = Nom & Chr(10) & Chr(10) & "Dernière mise à jour : " & FL21.Range("H1")
    Chaine = "Chose" & Chr(10) & Chr(10) & "Dernière mise à jour : " & "Un autre texte"
    For Each Cell In Range("H" & PremLig & ":" & "H" & DerLig)
        Cell.Value = Chaine
        Ch1 = Left(Chaine, InStr(Chaine, vbLf) - 1)
        Lch1 = Len(Ch1)
        Ch2 = Mid(Chaine, InStr(Chaine, vbLf) + 2, Len(Chaine) - InStr(Chaine, vbLf) + 2)
        LCh2 = Len(Ch2)
        With Cell.Characters(Start:=Lch1 + 3, Length:=LCh2).Font
                .ColorIndex = 5
        End With
    Next
End Sub

Essaie de t'inspirer de ça.
A+

**ancel17** · 25/10/2007, 23h40

Mille excuses, j'ai omis de te remercier pour ta réponse que je n'ai d'ailleurs pas encore eu le temps de tester...

je me pose une question concernant le code que tu m'as donné pour la suppression des MFC :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    'suppression de la mise en forme conditionnelle... s'il en existe une
    Worksheets("feuil1").Range("D1").FormatConditions.Delete

je l'utilise ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address Like "$E$*" Then
    If Target.Value = "non" Then
        Worksheets("Suivi candidatures").Range(Cells(Target.Row, 4)).FormatConditions.Delete
        Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 3
    ElseIf Target.Value = "oui" Then
        Worksheets("Suivi candidatures").Range(Cells(Target.Row, 4)).FormatConditions.Delete
        Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 10
    Else
        Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 0
    End If
End If
End Sub

Mais il me donne une erreur pointant sur la ligne de suppression MFC :

Erreur d'exécution '1004':
Erreur définie par l'application ou par l'objet

Y a-t-il une librairie à ajouter dans les références ?

**mapeh** · 26/10/2007, 01h37

Bonjour, tu ne peux pas "intervenir" directement dans une autre feuille de cette façon. il faut précéder avec With :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then
  With Worksheets("Suivi candidatures")
    If Target.Value = "non" Then
         .Range(Cells(Target.Row, 4)).FormatConditions.Delete
         Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 3
    ElseIf Target.Value = "oui" Then
         .Range(Cells(Target.Row, 4)).FormatConditions.Delete
         Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 10
    Else
        Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Font.ColorIndex = 0
    End If
 End With
End If
End Sub

Non testé, mais c'est la façon de procéder sur une autre feuille à partir d'un évènement de feuille

**ancel17** · 26/10/2007, 11h24

merci de ta réponse mapeh,

cependant je ne change pas de feuille vu que je n'en ai qu'une dans ce fichier.
le Worksheets("suivi candidatures") était là pour la lisibilité... Apparemment c'était pas une idée terrible

**mapeh** · 26/10/2007, 12h06

Bonjour ancel,
dans ce cas, tu peux l'enlever.
le problème vient de ta façon de désigner la cellule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("Suivi candidatures").Range(Cells(Target.Row, 4))

remplace par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("Suivi candidatures").Cells(Target.Row, 4)

**ancel17** · 11/12/2013, 11h20

Bonjour,

Vu la date du dernier post, j'imagine que j'avais dû résoudre le problème...

[VBA EXCEL] - Importer une plage de valeur sans les formule et Mise en Forme Cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager