Problème majuscule

Le 18/08/2016 à 17:21

Bonjour à tous, j'ai trouvé ce code sur le forum pour forcer les majuscules :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("E10:E11")) Is Nothing Then
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
End If

End Sub

le code fonctionne mais quand je lance mon autre macro (ci dessous j'ai ce message d'erreur et le 1er code ne fonctionne plus

Sub Rectangle11_Cliquer()
Application.ScreenUpdating = False

Sheets("AJOUT").Select
    Range("B2:G2").Select
    Selection.Copy
    Sheets("BDD").Visible = True
    Sheets("BDD").Select

    If Range("B2").Value = "" Then
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Else
    Range("B65535").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Range("Tableau1[[N°]:[EQUIPIER GPI]]").Select
    ActiveWorkbook.Worksheets("BDD").ListObjects("Tableau1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BDD").ListObjects("Tableau1").Sort.SortFields.Add _
        Key:=Range("Tableau1[[Grade ]]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, CustomOrder:="ADJ,SGC,SGT,CLC,CAL,AV1,AVT", DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("BDD").ListObjects("Tableau1").Sort.SortFields.Add _
        Key:=Range("Tableau1[Nom]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BDD").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    End If

    'Accueil
    Sheets("ACCUEIL").Select
    Columns("K:K").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("ACCUEIL").Select
    Range("K6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'CCPM
    Sheets("CCPM").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("CCPM").Select
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'VSA
    Sheets("VSA").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("VSA").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'LICENCE
    Sheets("LICENCE").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("LICENCE").Select
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'PLD
    Sheets("PLD").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("PLD").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'BADGE
    Sheets("BADGE").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("BADGE").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'FAMAS
    Sheets("FAMAS").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("FAMAS").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'RAMASSAGE
    Sheets("RAMASSAGE").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("RAMASSAGE").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'POIC
    Sheets("POIC").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("POIC").Select
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'INSTRUC
    Sheets("ENREGISTREMENT INSTRUC").Select
    Columns("B:B").Select
    Selection.ClearContents
    Sheets("BDD").Select
    Range("Tableau1[Grade Nom]").Select
    Selection.Copy
    Sheets("ENREGISTREMENT INSTRUC").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("BDD").Visible = False

    Sheets("AJOUT").Select
    Range("E10:E14").Select
    Selection.ClearContents

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

merci

sans titre
Le 18/08/2016 à 17:46

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("E10:E11")) Is Nothing Then
        Application.EnableEvents = False
        If Target <> "" Then Target = UCase(Target)
        Application.EnableEvents = True
    End If
End Sub
Le 18/08/2016 à 17:53

Merci MFerrand mais ça m'affiche ce message d'erreur

sans titre2
Le 18/08/2016 à 18:15

Je ne vois aucun message !

En faisant quoi ?

Le 18/08/2016 à 18:20

Celui- ci , pardon

sans titre3
Le 18/08/2016 à 18:30

Je repose donc la question : en faisant quoi ?

Le code de ta macro (que j'ai été obligé de parcourir rapidement malgré mon aversion ) ne met en cause E10:E11 que pour les effacer.

Que cherches donc tu à mettre dans ces cellules pour déclencher une incompatibilité de type ?

Le 18/08/2016 à 18:37

Juste "GRADE en E10 "et "NOM en E11" et après "C2=E10 et C3=E11"

Le 18/08/2016 à 18:58

Ôte-moi d'un doute ?

C'est bien le texte : "C2=E10" que tu mets ? Non une formule ?

Le 18/08/2016 à 19:06

oui, C2=E10

Le 18/08/2016 à 19:19

Tant que tu tapes des valeurs texte ou assimilées, l'erreur que tu indiques ne peut pas se produire !

Le 18/08/2016 à 19:30

Non je t'assures, les 2 cellules sont vides, je viens de revérifier.

Le 19/08/2016 à 13:08

Je viens de trouver le problème , quand je met ce bout de code en commentaire je n'ai plus d'erreur, le soucis c'est que je ne peux plus effacer "E10:E14"

Range("E10:E14").Select
    Selection.ClearContents
Le 19/08/2016 à 13:24

Je crois que cela vient du fait que Target est alors une plage de plusieurs cellules...

Modifie l'évènementielle ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range, c As Range
    Set isect = Intersect(Target, Range("E10:E11"))
    If Not isect Is Nothing Then
        Application.EnableEvents = False
        For Each c In isect.Cells
            If c <> "" Then c = UCase(Target)
        Next c
        Application.EnableEvents = True
    End If
End Sub

Rétablis ta commande d'effacement. Et teste...

Cordialement.

Le 19/08/2016 à 15:22

Ça fonctionne parfaitement MFerrand, un grand merci à toi pour ton aide.

Est t'il possible de forcer la cellule "E12" à mettre la 1ere lettre en majuscule ? Merci

Le 19/08/2016 à 15:36
range("E12")=application.worksheetfunction.proper(range("E12"))
Le 19/08/2016 à 15:59

Remodification pour intégrer E12 (et unification de la procédure...):

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range, c As Range, conv As Integer
    Set isect = Intersect(Target, Range("E10:E12"))
    If Not isect Is Nothing Then
        Application.EnableEvents = False
        For Each c In isect.Cells
            If c <> "" Then
                conv = IIf(c.Row < 12, vbUpperCase, vbProperCase)
                c = StrConv(c, conv)
            End If
        Next c
        Application.EnableEvents = True
    End If
End Sub
Le 19/08/2016 à 16:12

je comprend pas grand chose mais tout fonctionne . Tu es impressionnant MFerrand , un grand merci à toi pour ton aide.

Rechercher des sujets similaires à "probleme majuscule"