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

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

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, 22h18

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, 23h44

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, 09h40

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, 10h18

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, 17h12

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, 17h14

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, 21h18

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 :