RESOLU - macro ajoute 33 en trop

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

J'ai un souci de modification d'une macro qui m'avait été transmise par un membre su site (je n'ai pas retrouvé le fil) et qui fonctionne très bien :

Code:
Sub AjouteN33()
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Select
ActiveSheet.Unprotect Password:="Krameri"
[B]ActiveCell.Offset(0, -8).Select[/B]
Dim Lg%, i%
    Application.ScreenUpdating = False
    Lg = Range("n65536").End(xlUp).Row
        For i = 4 To Lg
            If Left(Cells(i, "n"), 2) <> "33" And Cells(i, "n") <> "" Then
                Cells(i, "n") = "33" & Cells(i, "n")
            End If
        Next i
ActiveCell.Offset(0, 8).Select
End Sub

la fonction de cette macro est d'ajouter un 33 devant tout numéro de téléphone saisi.
Cette macro ajoute le 33 sur toutes les lignes qui contiennent un numéro de téléphone.

Je souhaiterai que cet ajout ne se fasse que sur la cellule concerné : ActiveCell.Offset(0, -8).Select

Évidemment, malgré tous mes essais, je n'ai pas réussi à la modifier valablement.

Pourriez-vous m'aider encore une fois ?
Un grand merci à vous tous,
Amicalement,
Calimero,
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : MOdification d'une macro

Bonjour à tous,

Peux-tu essayer :

Code:
Sub AjouteN33() 
   If Left(ActiveCell, 2) <> "33" And ActiveCell <> "" Then ActiveCell = "(33)" & ActiveCell.Value
End Sub

ou

Code:
ActiveCell.NumberFormat = """(33)""#"" ""##"" ""##"" ""##"" ""##"

A+ à tous
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : MOdification d'une macro

Re-bonjour,

ça fonctionne très bien ... un grand merci.
Cependant, j'ai un petit souci :

Quand je je saisie un numéro qui commence par 33, il ne m'ajoute pas le 33 devant. (classeur joint)
J'essaie de trouver ....

Un grand merci,
Amicalement,
Caliméro,
 

Pièces jointes

  • Test forum.xlsm
    24.2 KB · Affichages: 30
  • Test forum.xlsm
    24.2 KB · Affichages: 33
  • Test forum.xlsm
    24.2 KB · Affichages: 33

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : MOdification d'une macro

Bonjour JCGL,
Bonjour à toutes et à tous,

Non, c'est moi qui ne l'ai pas mise en évidence.
Mais j'ai avancé sur mon classeur (j'y ai passé toute la journée et j'ai encore 3 soucis que je n'arrive pas à solutionner. J'suis nul LOL)

1 - Je n'arrive pas à trouver ce qui me manque dans le code pour afficher le résultat de l'exécution de la macro dans la cellule saisie. Il me calcul dans la cellule qui suit après validation Exemple : si je saisie dans la cellule G7, après validattion, Si je sélectionne n'importe quelle cellule de la feuille, le résultat de la macro se met dans cette cellule. 2 - si je saisie un n° qui commence par 33 ou 333 etc … ou pire si les 9 chiffres ne sont que des 3 … pas d'ajout de 33 devant 3 - j'ai besoin de borner un nombre de chiffres saisis : < ou > à 9 chiffres = pas bon

Voici ce que j'ai fait (avec l'aide des codes qui m'ont été transmis par les membres du site) :
Code de la feuille "Ajout33"
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("G7:G2000")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call AjouteG33
'Application.EnableEvents = 0: Application.EnableEvents = 1 '...revient
ActiveCell.Offset(0, 0).Select
'MsgBox "33 ajouté."
End If

Set KeyCells = Range("H7:H2000")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call AjouteH33
'Application.EnableEvents = 0: Application.EnableEvents = 1 '...revient
ActiveCell.Offset(0, 0).Select
'MsgBox "33 ajouté."
End If
Application.EnableEvents = 0: Application.EnableEvents = 1 '...revient
End Sub

code Module AjouteIndTel (dans laquelle est ton code) :
Code:
Sub AjouteG33()
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Select
ActiveCell.Offset(0, -4).Select

   If Left(ActiveCell, 2) <> "33" And ActiveCell <> "" Then ActiveCell = "33" & ActiveCell.Value
   'ActiveCell.NumberFormat = """(33)""###"" ""###"" ""###"

Selection.Copy
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveCell.Offset(0, -4).Select
ActiveCell.FormulaR1C1 = _
        "=MID(IF(LEFT(NUMERO(RC[4]))=""0"",MID(NUMERO(RC[4]),2,9*9),NUMERO(RC[4])),1,11)"
Application.CutCopyMode = False
ActiveCell.Offset(0, 4).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub AjouteH33()
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Select
ActiveCell.Offset(0, -4).Select

   If Left(ActiveCell, 2) <> "33" And ActiveCell <> "" Then ActiveCell = "33" & ActiveCell.Value
   'ActiveCell.NumberFormat = """(33)""###"" ""###"" ""###"

Selection.Copy
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveCell.Offset(0, -4).Select
ActiveCell.FormulaR1C1 = _
        "=MID(IF(LEFT(NUMERO(RC[4]))=""0"",MID(NUMERO(RC[4]),2,9*9),NUMERO(RC[4])),1,11)"
Application.CutCopyMode = False
ActiveCell.Offset(0, 4).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Code Fonction :
Code:
Function Numero(ByVal txt As String) As String
With CreateObject("VBScript.RegExp")
    .Pattern = "\D+"
    .Global = True
    Numero = .Replace(txt, "")
End With
End Function

Je joins le classeur,
Ton aide et votre aide me sera précieuse comme d'habitude.
Avec un grand merci jamais assez grand :)
Bon WE à tous,
Amicalement,
Calimero,
 

Pièces jointes

  • Ajoute 33 test17.xlsm
    27.5 KB · Affichages: 21
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : MOdification d'une macro

Bonjour JC,
Bonjour à toutes et à tous,

Est-il possible de rester dans la même cellule après validation (entrée) ?
Je m'explique :
Je suis par exemple dans la cellule G7 ... je saisie ... je valide et s'est ma cellule G7 qui est sélectionnée.
Une macro peut-être .... j'ai pas trouvé malgré mes recherches.

Merci de votre aide,
Amicalement,
Caliméro,
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : MOdification d'une macro

Re bonjour JC, à toutes et à tous,

J'aurais du commencer par vous dire pourquoi j'ai besoin de faire tout ça :

En fait, je travaille en appels téléphoniques et je fais copier/coller de mes numéro sur sites.
Ces numéros sont toujours soit :
- avec des espaces,
- des signes (/ ou - etc.) entre les chiffres,
- et encore des espaces après les chiffres (espaces au format différent de ceux d'excel).
Afin de pouvoir appeler en copiant sans avoir à ressaisir, mes n° dans mon téléphone X-lite (téléphone internet), il me faut avoir uniquement mes numéros (sans aucun espace) dans ma cellule et avec 33 devant puisque je suis en Tunisie. Donc, je dois extraire les chiffres.

J'ai un peu avancé sur mes soucis.
J'ai, je crois résolu mon problème n° 3 (bornage du nombre de chiffres copiés) en modifiant la formule (liée à la fonction NUMERO) de ma feuille en C et d :
=SI(ET(G7>99999999;G7<1000000000);STXT(SI(GAUCHE(NUMERO(G7))="0";STXT(NUMERO(G7);2;9*9);NUMERO(G7));1;11);"")

ça aussi j'ai résolu : Est-il possible de rester dans la même cellule après validation (entrée) ?
avec : Target.Select ... Mais cela ne résout pas mes soucis 1 et 2 et je ne trouve pas malgré mes essais et recherches.

Nouveau classeur joint,

Amicalement,
Calimero,
 

Pièces jointes

  • Ajoute 33 test 57.xlsm
    28.6 KB · Affichages: 20
  • Ajoute 33 test 57.xlsm
    28.6 KB · Affichages: 27
  • Ajoute 33 test 57.xlsm
    28.6 KB · Affichages: 36
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : MOdification d'une macro

Bonjour à tous

arthour973
[aparté]
J'aurais du commencer par vous dire pourquoi j'ai besoin de faire tout ça :
En fait, je travaille en appels téléphoniques et je fais copier/coller de mes numéro sur sites.
Cela tu nous l'a déjà dit mais dans un autre fil ;)

https://www.excel-downloads.com/thr...-de-chiffres-sans-espace-dans-cellule.231671/

Si tu n'éparpillais pas ta question dans plusieurs fils, on arriverait mieux à te suivre et surtout on saurait dans quel fil répondre...:rolleyes:
[/aparté]
 

Cousinhub

XLDnaute Barbatruc
Re : MOdification d'une macro

Bonjour JC,
Bonjour à toutes et à tous,

Est-il possible de rester dans la même cellule après validation (entrée) ?
Je m'explique :
Je suis par exemple dans la cellule G7 ... je saisie ... je valide et s'est ma cellule G7 qui est sélectionnée.
Une macro peut-être .... j'ai pas trouvé malgré mes recherches.

Merci de votre aide,
Amicalement,
Caliméro,

Bonjour,

Salut l'agrafe... :)

Juste pour répondre à cette question....(bien que d'autres solutions lui soient données sur d'autres forums...)

A insérer dans le code du ThisWorkbook :

Code:
Private Sub Workbook_Activate()
Application.MoveAfterReturn = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlDown
End With
End Sub

Private Sub Workbook_Deactivate()
With Application
    .MoveAfterReturn = True
    .MoveAfterReturnDirection = xlDown
End With
End Sub

Private Sub Workbook_Open()
Application.MoveAfterReturn = False
End Sub

Bon dimanche

PS : mais on peut évidemment le faire sans macro, en allant dans les options, options avancées, décocher "Déplacement après validation"

Edit : J'avais oublié la procédure "Activate"...
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : MOdification d'une macro

Bonjour BHBH,

Merci pour vos codes, je vais tester.
C'est vrai que j'ai besoin d'avancer pour être prêt (peut-être) demain pour pouvoir travailler.

Mais c'est dimanche aujourd'hui et il m'a semblé normal que je n'ai pas de réponses sur le site.
C'est pour cela que j'ai fait une demande sur le site developpez.net.

Bon dimanche et à tous,
Amicalement,
Lionel,
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 183
dernier inscrit
karelhu35