Problème code VBA - majuscule

Le 24/03/2015 à 16:22

Bonjour,

la semaine passée, vous m'avez aidé avec mon code postal canadien dans mon fichier qui fonctionne merveilleusement.

Mais là, je voulais que pour mes colonnes f, g, i, j, l, n et o soit en majuscule sans accent.

J'ai trouvé ici un code qui fait cela mais lorsque je le mets avec mon autre code j'ai un message d'erreur et de plus je voudrais enlever le target 0.25 mais j'ose pas trop car j'ai peur de faire une erreur. Voici mes deux codes bout à bout.

Le premier est parfait mais c'est quand j'écris en minuscule et qu'il devrait convertir j'ai un message d'erreur : Erreur de compilation : nom ambigu détecté : Worksheet_change. Pouvez-vous m'aider

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rg As Range

Set Rg = Intersect(Target, Columns(16))

Application.EnableEvents = False

If Not Rg Is Nothing Then

For Each c In Rg

c.Value = UCase(Application.Trim(c))

If c.Value Like "[A-Z][0-9][A-Z] [0-9][A-Z][0-9]" Or _

c.Value Like "[A-Z][0-9][A-Z][0-9][A-Z][0-9­]" Then

c.Value = Left(c, 3) & " " & Right(c, 3)

c.Interior.ColorIndex = xlNone

c.Font.ColorIndex = xlAutomatic

ElseIf c.Value <> "" Then

MsgBox "la saisie du code postal est inexacte"

c.Interior.ColorIndex = 3

c.Font.ColorIndex = 2

Else

c.Interior.ColorIndex = xlNone

c.Font.ColorIndex = xlAutomatic

End If

Next

End If

Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim codeA As String, codeB As String, temp As String

Dim i As Byte, p As Byte

If Target.Row = 1 Then Exit Sub

If Not IsNumeric(Target) Then

codeA = "ÉÈÊËÔéèêëàçùôûïî"

codeB = "EEEEOeeeeacuouii"

temp = Target

For i = 1 To Len(Target)

p = InStr(codeA, Mid(Target, i, 1))

If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)

Next

Application.EnableEvents = False

Target = UCase(temp)

Else:

Application.EnableEvents = False

Target = Application.Ceiling(Target, 0.25)

End If

Application.EnableEvents = True

End Sub

Le 25/03/2015 à 02:37

Tu as en effet 2 procédures Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Il faut inclure ton second code dans la première procédure.

Le 25/03/2015 à 07:25

Bonjour,

Les 2 macros assemblées : (supprimer les précédentes)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim codeA$, codeB$, temp$, i As Byte, p As Byte, Rg As Range, c
Set Rg = Intersect(Target, Columns(16))
On Error GoTo GESTERR
Application.EnableEvents = False
   If Not Rg Is Nothing Then
      For Each c In Rg
         c.Value = UCase(Application.Trim(c))
            If c.Value Like "[A-Z][0-9][A-Z] [0-9][A-Z][0-9]" Or _
               c.Value Like "[A-Z][0-9][A-Z][0-9][A-Z][0-9­]" Then
               c.Value = Left(c, 3) & " " & Right(c, 3)
               c.Interior.ColorIndex = xlNone
               c.Font.ColorIndex = xlAutomatic
            ElseIf c.Value <> "" Then
               MsgBox "la saisie du code postal est inexacte"
               c.Interior.ColorIndex = 3
               c.Font.ColorIndex = 2
            Else
               c.Interior.ColorIndex = xlNone
               c.Font.ColorIndex = xlAutomatic
            End If
      Next
   End If
Application.EnableEvents = True
'Part2
   If Target.Row = 1 Then Exit Sub
   If Not IsNumeric(Target) Then
      codeA = "ÉÈÊËÔéèêëàçùôûïî"
      codeB = "EEEEOeeeeacuouii"
      temp = Target
         For i = 1 To Len(Target)
            p = InStr(codeA, Mid(Target, i, 1))
            If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
         Next
      Application.EnableEvents = False
      Target = UCase(temp)
   Else:
      Application.EnableEvents = False
      Target = Application.Ceiling(Target, 0.25)
   End If
Application.EnableEvents = True
ExitSub
GESTERR:
   Application.EnableEvents = True
   MsgBox "Une erreur est intervenue"
End Sub

J'ai juste rajoutée une gestion d'erreur car ce type de code est un peu "casse-cou" :

En cas d'apparition du message revenir en précisant quelle manip à provoqué le message.

A+

Le 26/03/2015 à 18:31

Allo,

bon j'ai copié la programmation et lorsque j'écris, j'ai ce message :

Erreur de compiliation : Sub ou Funciton non défini

et il se place à la fin sur Exitsub...

pkoi ?

bon,

j'ai fusionné mes deux codes sans faire aucun changement. Tout va bien, par contre, si j'écris quelque chose dans une cellule et que par la suite je l'efface, il me met un zéro (0). Pkoi fait-il cela. Si je veux effacer le contenu, je ne veux rien avoir....

Ah c'était le 0.25... qui faisait ce problème.

Donc pour l'instant je continue mes tests pour voir si tout est ok.

Le 26/03/2015 à 18:49

Bon tout va bien partout dans mon fichier.

par contre, j'ai une question.

Lorsque je sélectionne plusieurs cellule pour effacer avec Suppr il me dit : Erreur d'exécution "13" : Incompatibilité de type

comment puis-je régler ce problème car je dois envoyer ce fichier à plusieurs personnes qui ne connaissent rien en VBA, je ne veux donc pas ce type de message...

Merciiiii d'avance pour votre aide.

Le 26/03/2015 à 22:58

Bonsoir,

il faut corriger :

Exit Sub

En principe, on évite d'écrire des macros de ce type qui s'appliquent à plusieurs cellules. Pour cette raison on met habituellement dans cette macro cette condition :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim codeA$, codeB$, temp$, i As Byte, p As Byte, Rg As Range, c
If Target.count = 1 then
'Suite de la macro
...
End if
End Sub

Par suite la macro ne s'applique que lorsqu'on modifie une seule cellule.

Par suite le For each C in rg ... Next n'a pas de sens (est inutile) : C ne pouvant qu'être unique.

Il n'y a pas d'autres solutions.

A+

Le 27/03/2015 à 15:08

J'ai mis ça comme code et non celui du haut :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rg As Range

Set Rg = Intersect(Target, Columns(16))

Application.EnableEvents = False

If Not Rg Is Nothing Then

For Each c In Rg

c.Value = UCase(Application.Trim(c))

If c.Value Like "[A-Z][0-9][A-Z] [0-9][A-Z][0-9]" Or _

c.Value Like "[A-Z][0-9][A-Z][0-9][A-Z][0-9­]" Then

c.Value = Left(c, 3) & " " & Right(c, 3)

c.Interior.ColorIndex = xlNone

c.Font.ColorIndex = xlAutomatic

ElseIf c.Value <> "" Then

MsgBox "la saisie du code postal est inexacte"

c.Interior.ColorIndex = 3

c.Font.ColorIndex = 2

Else

c.Interior.ColorIndex = xlNone

c.Font.ColorIndex = xlAutomatic

End If

Next

End If

Application.EnableEvents = True

'part2

If Target.Row = 1 Then Exit Sub

If Not IsNumeric(Target) Then

codeA = "ÉÈÊËÔéèêëàçùôûïî"

codeB = "EEEEOeeeeacuouii"

temp = Target

For i = 1 To Len(Target)

p = InStr(codeA, Mid(Target, i, 1))

If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)

Next

Application.EnableEvents = False

Target = UCase(temp)

Else:

Application.EnableEvents = False

End If

Application.EnableEvents = True

End Sub

Y a t-il quelque chose à corriger pour éviter le message d'erreur ?

Rechercher des sujets similaires à "probleme code vba majuscule"