Passez une cellule Excel en italique

alors, je penses, séléctionne le texte et met en italique lol

Le truc c'est que j'ai plusieurs milliers de cellules à traiter. donc j'aurai voulu pouvoir automatiser ça.

cliquer 2 fois sur la cellule puis sélectionner la partie en question puis passer au menu format ----> cellule ------> police et cliquer sur "Italique" de la zone style

Bonjour,
Le contenu des cellules concernées sont toutes identiques ou presque? J'entends par la qu'elles doivent toutes être selon ce schéma : écriturenormale / italique la partie à "italiquer" étant systématiquement placée derrière un "/". Si tel est le cas, on ne peux que passer par une macro. Sinon, merci de détailler votre description du tableau et des cellules concernées.

Les cellules suiventes toutes le meme format à savoir : "écriturenormale" / "écritureitalique"

Dernières questions avant de passer à l'écriture de notre macro :
1- Ce formatage de cellules concerne toutes les cellules de ta feuille?
2- Une partie seulement?
3- Si oui y a t'il des "/" dans d'autres cellules de ta feuille?
4- Plusieurs feuilles sont elles concernées?
5- plusieurs classeurs?

Je te propose cette macro à lancer sur la bonne colonne :

Sub transform()

Dim chaine As String
Dim lig, pos, lgt As Long
'On paramètre la première ligne (ici 1)
lig = 1
'Boucle qui passe sur chaque ligne et qui s'arrete quand il n'y a plus rien dans la colonne A
Do While Not (Range("A" & lig) = "")
    
    chaine = Range("A" & lig).Value
    'Récupère la position du /
    pos = InStr(chaine, "/")
    'Calcul de la longeur du texte à mettre en italique
    lgt = (Len(chaine) - pos) + 1
    
    'On change la police depuis la position du '/'
    With Range("A" & lig).Characters(Start:=pos, Length:=lgt).Font
        .FontStyle = "Italique"
    End With
    'On passe à la ligne suivante
    lig = lig + 1
    
Loop

End Sub

Et là j'ai ajouter un test qui verifie qu'il y a bien un '/' sinon ça met toute la cellule en italique :

Sub transform()

Dim chaine As String
Dim lig, pos, lgt As Long
'On paramètre la première ligne (ici 1)
lig = 1
'Boucle qui passe sur chaque ligne et qui s'arrete quand il n'y a plus rien dans la colonne A
Do While Not (Range("A" & lig) = "")
    
    chaine = Range("A" & lig).Value
    'Récupère la position du /
    pos = InStr(chaine, "/")
    'Calcul de la longeur du texte à mettre en italique
    lgt = (Len(chaine) - pos) + 1
    'S'il y a bien un '/'
    If Not pos = 0 Then
        'On change la police depuis la position du '/'
        With Range("A" & lig).Characters(Start:=pos, Length:=lgt).Font
            .FontStyle = "Italique"
        End With
    End If
    'On passe à la ligne suivante
    lig = lig + 1
    
Loop

End Sub

Salut Raph04,
Un autre code :

Sub partieitalique()
Dim debut As Integer, longueur As Integer 'définition des variables
For Each cell In ActiveSheet.UsedRange 'pour toutes les cellules de la feuille
If InStr(cell, "/") = 0 Then 'si la cellule ne contient pas de /
GoTo suite 'alors on passe à la suivante
End If
debut = InStr(cell, "/") 'place du / dans la chaine de caractères contenue dans la cellule
longueur = Len(cell) - debut + 1 'longueur de la chaine de caractères contenue dans la cellule
With cell.Characters(Start:=debut, Length:=longueur).Font 'avec la police de cette partie de cellule
.FontStyle = "Italique" 'et bien mettons la en italique
End With
suite:
Next 'cellule suivante s'il vous plait
End Sub 'fin macro

Ce code est a placé dans un module VBA : ALT + F11 Insertion/Module
Copier coller tout le code ci dessus dans la fenêtre qui vient de s'ouvrir puis fermer cette fenêtre.
Pour utiliser la macro : ALT + F8
Sélectionner "partieitalique" et cliquer sur exécuter.
Bon courage

Sub transform()

Dim chaine As String
Dim lig, pos, lgt As Long
'On paramètre la première ligne (ici 1)
lig = 1
'Boucle qui passe sur chaque ligne et qui s'arrete quand il n'y a plus rien dans la colonne A
Do While Not (Range("A" & lig) = "")

chaine = Range("A" & lig).Value
'Récupère la position du /
pos = InStr(chaine, "/")
'Calcul de la longeur du texte à mettre en italique
lgt = (Len(chaine) - pos) + 1
'S'il y a bien un '/'
If Not pos = 0 Then
'On change la police depuis la position du '/'
With Range("A" & lig).Characters(Start:=pos, Length:=lgt).Font
.FontStyle = "Italique"
End With
End If
'On passe à la ligne suivante
lig = lig + 1

Loop

End Sub

Merci beaucoup cette macro fonctionne très bien. J'ai une dernière question, est il possible d'affecter la macro au classeur entier?

Simon

Oui en bouclant sur toutes les feuilles de ton classeur actif :

Dim Ws As Worksheet
For Each Ws In ActiveWorkbook
     ton code ici
Next Ws

Oui en effet.
Mais, pour mon code cela reste sur la colonne A (ou X autre colonne choisie) ;-)

Cette solution va t elle me permettre d'appliquer la macro à toute les colonnes/cellules de ma feuille? ainsi qu'à toute les feuilles de mon classeur?

Simon

Pour que cela marche sur toute les colonnes, prend le code de pijaku et ajoute le "Pour chaque Feuille" :

Sub partieitalique()
    Dim Ws As Worksheet
    Dim debut As Integer, longueur As Integer 'définition des variables
    For Each Ws In ActiveWorkbook
        For Each cell In ActiveSheet.UsedRange 'pour toutes les cellules de la feuille
            If InStr(cell, "/") = 0 Then 'si la cellule ne contient pas de /
                GoTo suite 'alors on passe à la suivante
            End If
            debut = InStr(cell, "/") 'place du / dans la chaine de caractères contenue dans la cellule
            longueur = Len(cell) - debut + 1 'longueur de la chaine de caractères contenue dans la cellule
            With cell.Characters(Start:=debut, Length:=longueur).Font 'avec la police de cette partie de cellule
                .FontStyle = "Italique" 'et bien mettons la en italique
            End With
        Next 'cellule suivante s'il vous plait
    Next Ws
End Sub 'fin macro

Sub partieitalique()
Dim debut As Integer, longueur As Integer 'définition des variables
For Each cell In ActiveSheet.UsedRange 'pour toutes les cellules de la feuille
If InStr(cell, "/") = 0 Then 'si la cellule ne contient pas de /
GoTo suite 'alors on passe à la suivante
End If
debut = InStr(cell, "/") 'place du / dans la chaine de caractères contenue dans la cellule
longueur = Len(cell) - debut + 1 'longueur de la chaine de caractères contenue dans la cellule
With cell.Characters(Start:=debut, Length:=longueur).Font 'avec la police de cette partie de cellule
.FontStyle = "Italique" 'et bien mettons la en italique
End With
suite:
Next 'cellule suivante s'il vous plait

Dim Ws As Worksheet
Dim debut As Integer, longueur As Integer 'définition des variables
For Each Ws In ActiveWorkbook
For Each cell In ActiveSheet.UsedRange 'pour toutes les cellules de la feuille
If InStr(cell, "/") = 0 Then 'si la cellule ne contient pas de /
GoTo suite 'alors on passe à la suivante
End If
debut = InStr(cell, "/") 'place du / dans la chaine de caractères contenue dans la cellule
longueur = Len(cell) - debut + 1 'longueur de la chaine de caractères contenue dans la cellule
With cell.Characters(Start:=debut, Length:=longueur).Font 'avec la police de cette partie de cellule
.FontStyle = "Italique" 'et bien mettons la en italique
End With
Next 'cellule suivante s'il vous plait
Next Ws
End Sub 'fin macro

Voici les deux macros compilées comme Raph m'a dit de faire seulement il y a un message d'erreur qui me dit qu'il y a une erreur de compilation : Déclaration existante dans la portée en cours. tout en surlignant "debut As Integer" sur la deuxième ligne de la deuxième partie de la macro.

Quel est le problème?

Simon

Essaye plutôt ceci :

Sub partieitalique()
Dim debut As Integer, longueur As Integer, j As Integer
    For j = 1 To Sheets.Count
    Sheets(j).Activate
        For Each cell In ActiveSheet.UsedRange
            If InStr(cell, "/") = 0 Then
                GoTo suite
            End If
            debut = InStr(cell, "/")
            longueur = Len(cell) - debut + 1
            With cell.Characters(Start:=debut, Length:=longueur).Font
                .FontStyle = "Italique"
            End With
suite:
        Next
    Next j
End Sub

Ca fonctionne parfaitement,

merci à vous pour votre rapidité et vos connaissances.

Simon