Macros avec Word
Macro terminator

En utilisant le fichier echantillon-ADN-Mouche-Mathusalem.docx contenant cette info

Echantillon

1 ggtaaacaaa tgctaaacag ctgatagcaa taacacattt tattcagcga gtttgtttct
41 ttcgatttaa actcgagttt taatgtggtt tactatttaa acgtgacaaa gtactattgt
131 taagtatgcc aaaacacggc ttaagttgtt tataaaaccg gatgctggct cataacctag
181 gtttccataa aaagcgcctt ttttcaaaca tgaaggctgt tttacaggat cggggtgtca
251 taggcttatc cctcgaagaa tgcgatttgg aaagaacttt gcttggagga cagagtttcc
301 ggtaagcgct atccatacta ataatgaaca tatgtactca aaacaacttt acatgccaga
351 tggcgatcca tatgcgatgg taatagaacg aaatatggcg gagtggtgtt caacacctac
431 tgggtgctcc agcaagaaga atccttcata acttacgagg catacggaac cagcagtcct
441 ttggccacga aggactattc ttccttgata tctgactacc tacgtgttga tttcgaccta
531 aaggtcaacc aaaaagattg gttaagcaaa gatgataact ttgtgaagtt cttgagtaag
611 cctgtgcgcc tcctttctca ggagccgttc gaaaacattt ttagcttcct ttgcagtcag
641 aacaataaca tcaagcggta ggtggttcaa tcaaatgcga atcccatcat taaatacagt
781 aaattggttt cttcttagca tatcatctat gattgaatgg ttttgcgcta catttggcac
791 caagattggt cacttcaatg gtgccgatgc gtatacattt cccacgataa atagattcca
851 cgacatccca tgcgaggatc ttaatgccca gctaagggct gccaagttcg gttatcgggc
911 caagttcata gcacaaacgc tgcaagagat ccagaaaaag gggggacaaa actggttcat
971 aagcctaaag agcatgccgt tcgaaaaagc tcgcgaggag ctgacactgc tacccggaat
1031 cggatacaaa gtggccgatt gcatctgcct tatgtcaatg ggtcacttgg agtcagtgcc
1091 cgtcgacatt catatttaca gaattgccca aaattactac ctgccacatc taaccggcca
1151 aaagaacgta accaagaaga tttacgaaga ggtctcgaaa cattttcaaa agctacacgg
1201 aaagtatgcc ggttgggctc aagctgtaag tacactgaaa gttgcaattt agtctgtgtg
1281 tttcttataa tatcattatt tcagattctc ttttctgccg atttgagtca atttcaaaat
1331 acttccacag ttgcttgtaa gaaaaaatcc aataaaaaac ctaaaaagtg atcttatcta
1341 ttggattaaa aaaaaaaata ttcctacttg taatatttga atattaaaat ataatagaaa
1451 tgtatatact aatgtatata taaatatata tctaaacaga gaaag

 

créez la macro terminator 

permettant de supprimer tous les chiffres de l’échantillon ansi que tous les caractères espaces.

Au final, cette macro contiendra le code suivant :

Code de la macro terminator

Sub terminator()
 ' terminator Macro
 ' tue espace
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
   .Text = " "
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll

 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
   .Text = "^#"
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Extension de terminator -> terminator2

Ajouter le code
 

reponse = MsgBox("Voulez-vous vraiement lancer le terminator ?", vbYesNo, "Avertissement")

If (reponse = vbYes) Then
 …..  l’ ancien code de terminator

end if

pour créer un filet de sécurité.

Au final, cette macro contiendra le code suivant :

Code de la macro terminator2

Sub terminator2()
 ' terminator Macro
 ' tue espace
  reponse = MsgBox("Voulez-vous vraiement lancer le terminator ?", vbYesNo,"Avertissement")
  If (reponse = vbYes) Then
  Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
  With Selection.Find
  .Text = " "
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

end if

End Sub

Extension de terminator -> terminator3

Utilisation de procédures pour simplifier l’appel.

On écrira 

If (reponse = vbYes) Then
 Call rechercherEtRemplacerSansCaracteresGeneriques("^#", "") 
 Call rechercherEtRemplacerSansCaracteresGeneriques(" ", "") 
End Sub

La procédure sera décrite par le code suivant :

Sub rechercherEtRemplacerSansCaracteresGeneriques(texteAChercher,texteDeRemplacement)
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting

 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Code de la macro terminator3

Sub terminator3()
reponse = MsgBox("Voulez-vous vraiement lancer le terminator ?", vbYesNo, "Avertissement")
 If (reponse = vbYes) Then
  Call rechercherEtRemplacerSansCaracteresGeneriques("^#", "")
  Call rechercherEtRemplacerSansCaracteresGeneriques(" ","") 
End Sub

Sub rechercherEtRemplacerSansCaracteresGeneriques(texteAChercher,texteDeRemplacement)
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Nucweight

Autre codes

 
Sub Nucweight()
 '
 'Nucweight Macro
 'Macro recorded 07/02/99 by Gerry Shaw
 'This version for DNA sequences: for RNA MW for A =329.2, U = 306.1, G = 345.2, C= 305.2 '
 X = Len(Selection.Text)
 For Y = 1 To X

Sub Nucweight()
'
'Nucweight Macro
'Macro recorded 07/02/99 by Gerry Shaw
'This version for DNA sequences: for RNA MW for A =329.2, U = 306.1, G = 345.2, C= 305.2 '
X = Len(Selection.Text)
For Y = 1 To X
Select Case Mid$(Selection.Text, Y, 1)
    Case "A"
    MW = MW + 313.2
    Case "T"
    MW = MW + 304.2
    Case "G"
    MW = MW + 329.2
    Case "C"
    MW = MW + 289.2
    Case Else
    Z = Z + 1

End Select
Next
MW = MW + 18
If (MW > 18) Then
MsgBox ("Selection includes " & X - Z & " bases, Molecular Weight= " & MW & " Daltons")
End If

If (MW = 18) Then
 MsgBox ("No sequence selected")
End If

End Sub

CopieTexteSpecial

Autre codes

Sub CopieTexteSpecial()
 Selection.PasteSpecial Link:=False, _
 DataType:=wdPasteText, _
 Placement:= wdInLine, DisplayAsIcon:=False
End Sub



CopieTexteSpecial (ancienne version)

Autre codes

Sub CopieTexteSpecial()
' PasteTextSpecial => http://www.domainwebcenter.com/?p=290
    On Error GoTo Unicode
    Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
        Placement:=wdInLine, DisplayAsIcon:=False
    GoTo Done
Unicode:
    Selection.PasteAndFormat (wdFormatPlainText)
Done:
End Sub


Conversion d'un nombre en Scientifique normalise

Conversion d’un nombre en Scientifique normalise

Attention: ce programme ne fonctionne que si les nombres ne sont pas dans des cellules. Si les nombres sont séparés par des caractères du style tabulation (dans le cas d’un tableau importé), cet algorithme fonctionne.

 Sub ConvNbEnNotationScientifiqueNormalisee()

  ' Ce programme s’appuie sur le code trouvé à l’URL suivante https://superuser.com/questions/1142900/scientific-notation-in-microsoft-word
   ' reponse = MsgBox("Voulez-vous des espaces insécables avant ET Apres la croix de mltiplcation ?", vbYesNo, "Avertissement")
  ' Finalement, je ne pose pas la question. La réponse serait toujours 'Non'.
  ' Mais au cas où, il suffira de changer  l'instruction ci-dessous
   reponse = vbNo
  
    ' put in general form
    Call rechercherEtRemplacer("([0-9.]@)E([-+0-9]@)([!0-9])", "\1##x10§§\2##\3", True)
    
    ' take out leading 0 exponents  - Transforme un 10^+037 en 10^+37
     Call rechercherEtRemplacer("§§+0", "§§+", False)
         
    ' take out + exponents  - Transforme un 10^+20 en 10^20

     Call rechercherEtRemplacer("§§+", "§§", False)
    
  ' take out leading 0 exponents for negative numbers - Transforme un 10^-020   en 10^-20
    Call rechercherEtRemplacer("§§-0", "§§-", False)
    
    ' elevate exponents - met en superscript la puissance de 10
    Call rechercherEtRemplacerSuperscript("§§([-+0-9]@)##", "§§\1", True)
    
    Dim CroixMultiplication  As String
    Dim EspaceInsecable  As String
    FuturEventuelEspaceInsecable = "<futureventuelespaceinsecable>"
    CroixMultiplication = ChrW$(215)

   ChaineRemplacement = FuturEventuelEspaceInsecable &amp; _
     CroixMultiplication &amp; FuturEventuelEspaceInsecable &amp; 10
    
    ' free up x10
    Call rechercherEtRemplacer("##x10§§", ChaineRemplacement, False)
    
    ' enleve les chaines "<futureventuelespaceinsecable>" et remplace par des espaces insecables si l'option est activé
    If (reponse = vbYes) Then
        ChaineRemplacement = "^s"
     Else
         ChaineRemplacement = ""
    End If
    Call rechercherEtRemplacer(FuturEventuelEspaceInsecable, ChaineRemplacement, False)
    
End Sub

Sub rechercherEtRemplacer(texteAChercher, texteDeRemplacement, OptionCaractereGenerique)
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = OptionCaractereGenerique
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub rechercherEtRemplacerSuperscript(texteAChercher, texteDeRemplacement, OptionCaractereGenerique)
 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True   '&lt;---- ATtention, cette valeur doit etre à True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = OptionCaractereGenerique
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Un fichier contenant des macros à récupérer

Un fichier contenant des macros

Fichier avec les macros OSP13.beta1.docm

Un fichier contenant des macros à récupérer

Un fichier zippé contenant le module  Module_PL_Conv_v_1_0 contenant  la macro ConvNbEnNotationScientifiqueNormalisee 

Module_PL_Conv_v_1_0.docm.zip