XL 2013 recupérer une partie du code (en l'occurence le commentaire)

[patricktoulon]

bonjour a tous
j'ai une ligne de code par exemple

If toto ="Lig'10" then truc= "perlin'pinpin" 'ceci est un commentaire( ') qui est determiner par un " '" en debut

je voudrais récupérer le commentaire couper la ligne deux sans coupé le code effectif
sachant que dans le commentaire lui même il a des "'"
je remplace lionel avec ma question tordu du dimanche 🤣 🤣

 

[Gégé-45550]

bonjour a tous
j'ai une ligne de code par exemple

If toto ="Lig'10" then truc= "perlin'pinpin" 'ceci est un commentaire( ') qui est determiner par un " '" en debut

je voudrais récupérer le commentaire couper la ligne deux sans coupé le code effectif
sachant que dans le commentaire lui même il a des "'"
je remplace lionel avec ma question tordu du dimanche 🤣 🤣

Bonsoir Patrick,
La césure est à la position du premier apostrophe ( ' ) qui n'est pas entre deux guillemets ( " ), non ?
Je ne te ferai pas l'injure de te proposer du code pour programmer cette fonction, je sais que tu le feras beaucoup mieux que moi.
Je ne te ferai pas l'injure non plus de t'expliquer l'utilisation de Wbk.VBProject.VBComponents(NomFeuille).CodeModule pour "attaquer" le code d'un module de fichier Excel après avoir coché "Accès approuvé au modèle d'objet VBA" dans la section "Paramètres des macros" dans les options du Centre de gestion de la confidentialité.
Je ne sais pas si ce message te sera utile mais je poste à tout hasard.
Cdlt

 

[Nain porte quoi]

Hello,

je n'ai pas la solution, mais si vous vous inspirez du code de kiki29 qui supprime les commentaires, vous pourrez peut-être faire l'inverse

Supprimer les commentaires des modules VBA - VBA

Je cherche à supprimer rapidement tous les commentaires de tous les modules d'un classeur(excel). A force de rechercher sur internet, j'ai trouvé cela : Code : - 1 2 3 4 5 6 7 8 9 10 11 12 13 14 Public Function

www.developpez.net

 

[patricktoulon]

merci de vos retours je vais voir ça
@Gégé-45550 oui et non car dans cet exemple en effet on pourrait prendre cette règle
en fait avec un regex faire un execute puis sur les matche (boucle a reculons ça pourrait marcher
en fait si j'ajoute un "'" à la fin
il ne me reste plus qu'a chercher un " 'blablabla (')blablabla' ou 'blablabla'
c'est le pattern qui est dur a faire

@Nain porte quoi
je vais voir ça

 

[jurassic pork]

Hello,
A tester :

Sub CouperCommentaires()
Dim str, str2, regEx As Object, matches
str = "If toto =""Lig'10"" then truc= ""perlin'pinpin"" 'ceci est un commentaire( ') qui est determiner par un "" '"" en debut"
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "("".*?)'(.*?"")"  'on capture les 2 parties de chaines entourées de "" et avec un '
regEx.Global = True
str2 = regEx.Replace(str, "$1°$2") ' on remplace les ' par des °
regEx.Pattern = "'.*$"
Set matches = regEx.Execute(str2)
If matches.Count = 1 Then ' commentaire trouvé
  Debug.Print Replace(matches(0).value, "°", "'") ' on remet les ' à la place des °
End If
End Sub

Ne fonctionne pas si il y a plusieurs ' entre des "" et si des ° sont employés dans le code.
Ami calmant, J.P

 

[patricktoulon]

re merci @jurassic pork entre temps j'avais trouvé le truc
du moins j'espère j'ai pas tout testé

'patricktoulon IUT Toulon
Sub test()
    For i = 1 To 7
        MsgBox CommentaireVBA(Cells(i, 1))
    Next
End Sub
Function CommentaireVBA(ligne) As String
  If Left(Trim(ligne), 1) <> "'" Then
  Dim M As Object, Regex As Object, i&, comm$, debut$, addComm
    If Right(ligne, 1) <> "'" Then ligne = ligne & "'": addComm = True
    Set Regex = CreateObject("VBScript.RegExp")
    Regex.Pattern = "\s'([^']*')|(\s'\d+')"
    Regex.Global = True
    Set M = Regex.Execute(CStr(ligne))
    For i = M.Count - 1 To 0 Step -1
        comm = M(i) & comm
    Next
    'ici comm contient soit la première partie du commentaire soit le commentaire tout entier
    debut = Split(ligne, Trim(comm))(0)
    comm = Split(ligne, debut)(1)

    CommentaireVBA = Left(comm, Len(comm) - (1 * Abs(addComm)))
Else
    CommentaireVBA = ligne
End If
End Function

c'est même bizarre que ca marche avec ce pattern mais bon
en gros vous l'avez compris c'est un pattern conditionnel çà 'xxxx'xxx'xxx' ou ca 'xxxxxxx'
fichier joint

 

[patricktoulon]

re
@jurassic pork

Ne fonctionne pas si il y a plusieurs ' entre des "" et si des ° sont employés dans le code.

pour corriger ca j'ai modifier le 2d pattern "'.\D+$"

Sub testpork()
    For i = 1 To 7
       CouperCommentaires (Cells(i, 1))
    Next
End Sub


Sub CouperCommentaires(str)
Dim str2, regEx As Object, matches
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "("".*?)'(.*?"")"  'on capture les 2 parties de chaines entourées de "" et avec un '
regEx.Global = True
str2 = regEx.Replace(CStr(str), "$1°$2") ' on remplace les ' par des °
regEx.Pattern = "'.\D+$"
Set matches = regEx.Execute(str2)
If matches.Count = 1 Then ' commentaire trouvé
  Debug.Print Replace(matches(0).Value, "°", "'") ' on remet les ' à la place des °
End If
End Sub

finalement c'est @Gégé-45550 qui avait raison il faut traiter ceux qui son entre guillemet et prendre le premier restant
ouisque de toute facon a partir du moment ou il n'est pas entre guillemets c'est le départ du commentaire

 

[patricktoulon]

re

du coup et sans regex ça donne çà

'patricktoulon IUT Toulon
Sub testpat2()
    For i = 1 To 8
        CouperCommentaires2 (Cells(i, 1))
    Next
End Sub


Sub CouperCommentaires2(str)
    Dim ok As Boolean, i
    For i = 1 To Len(str)
        Select Case Mid(str, i, 1)
            Case """":  ok = Not ok
            Case "'": If ok Then Mid(str, i, 1) = "µ"
        End Select
    Next
Debug.Print Replace(Mid(str, Application.Max(InStr(1, str, "'"), 1)), "µ", "'")
End Sub

 

[patricktoulon]

Merci a tous 😉

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @patricktoulon

du coup et sans regex ça donne çà

Heu moi avec mon train de sénateur équipé d'un déambulateur :

Function SplitComm(Chaîne As String) As String()

     Dim C As String, NbC As Long, Continuer As Boolean, i As Long
     Dim Tb(1 To 2) As String
     Chaîne = Feuil1.[A1]
     NbC = Len(Chaîne)
     Continuer = True
     i = 1
     While Continuer And i <= NbC
          C = Mid(Chaîne, i, 1)
          If C = "'" Then
               Continuer = False
          Else
               If C = """" Then
                    i = i + 1
                    While Mid(Chaîne, i, 1) <> """" And i < NbC
                         i = i + 1
                    Wend
               End If
               i = i + 1
          End If
     Wend
    
     If i > 1 Then Tb(1) = Mid(Chaîne, 1, i - 1)
     If i < NbC Then Tb(2) = Mid(Chaîne, i)
     SplitComm = Tb
    
End Function

Voir le classeur joint

À bientôt

 

[patricktoulon]

@AtTheOne
met lui des roulettes au déambulateur 🤣 🤣

 

[jurassic pork]

Hello,
voici une autre solution avec des expressions régulières :

Sub RecupCommentairesJP(chaine)
Dim str As String, regEx As Object, objMatches As Object, Match As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = """.+?"""  'on capture ce qui est entre guillemets
regEx.Global = True
str = chaine
Set objMatches = regEx.Execute(str)
For Each Match In objMatches
    'str = début de chaine + remplacement de ' par ¤ dans la chaîne trouvée + fin de chaîne
    str = Mid(str, 1, Match.FirstIndex) + Replace(Match, "'", "¤") + Mid(str, Match.FirstIndex + Match.Length + 1)
Next
regEx.Pattern = "'.*$"
Set matches = regEx.Execute(str)
If matches.Count = 1 Then ' commentaire trouvé
  Debug.Print Replace(matches(0).Value, "¤", "'") ' on remet les ' à la place des °
End If
End Sub

1 - On récupère toutes les chaînes contenues entre guillemets
2 - On se sert des positions des chaînes trouvées pour substituer les ' par des ¤
3 - Normalement si il y a un commentaire il ne reste qu'un seul '
4 - On remet les ' à la place des ¤ dans le commentaire trouvé


Ami calmant, J.P

 

[mapomme]

Bonjour à tous 😉,

Allez pour une petite mise en route de début de semaine :

• si position est absent, on renvoie le commentaire (string vide si aucun commentaire)
• si position est présent, on renvoie la position de l'apostrophe du commentaire (0 si aucun commentaire)
• si le commentaire existe alors le commentaire renvoyé contient l'apostrophe (modifiable)

Function CommentaireLigneCode(ByVal x$, Optional position)
Const guill = """", apos = "'"
Dim i&, c$, isString As Boolean
   If InStr(x, apos) = 0 Then CommentaireLigneCode = IIf(IsMissing(position), "", 0)
   For i = 1 To Len(x)
      Select Case Mid(x, i, 1)
         Case guill: isString = Not isString
         Case apos: If Not isString Then CommentaireLigneCode = IIf(IsMissing(position), Mid(x, i), i): Exit Function
      End Select
   Next i
End Function

 

[patricktoulon]

Bonjour à tous
@mapome c'est le même principe que j'utilise (switch oui/non ) a occurrence du """
regarder le travail de déspaguetification avec ré indentation bien sur
c'est le futur moteur de vba Indenter qui est cette fois si en XML et plus en HTML

 

[job75]

Bonjour à tous,

Pas trop suivi mais le problème me paraît élémentaire :

Function CoupeComment(x$)
Dim i%, saute As Boolean
For i = 1 To Len(x)
    If Mid(x, i, 1) = """" Then saute = Not saute
    If Not saute Then If Mid(x, i, 1) = "'" Then CoupeComment = Mid(x, i) & vbLf & Trim(Left(x, i - 1)): Exit Function
Next
CoupeComment = Trim(x)
End Function

Nota : dans une cellule pour qu'une apostrophe en tête de texte soit visible et prise en compte il faut la doubler.

A+