Sub ConvertitAccordsEnDegrés()

'Auteur : JM CLIPET 29/10/2001

' Cette macro convertit les accords d'une grille (tableau) ou d'un morceau (texte)

' en degrés ( I II III IV V VI VII )

' Tout ce qui est en italique (Titres ou paroles...) n'est pas considéré comme accords

' et n'est donc pas transposé.

' De même tout ce qui est en exposant est considéré comme enrichissement et n'est donc pas transposé

' Par Ex Bb7 sera ransposé mais pas B(b5)

Dim lettre_chiffre(7) 'Pour convertir le nom de l'accord en degré de 1 à 12

lettre_chiffre(1) = 10 'Sans tenir compte des dièses et des bémols)

lettre_chiffre(2) = 12 '1 pour C, 3 pour D ... 12 pour B

lettre_chiffre(3) = 1

lettre_chiffre(4) = 3

lettre_chiffre(5) = 5

lettre_chiffre(6) = 6

lettre_chiffre(7) = 8

Dim Degre$(12)

Degre$(1) = "I"

Degre$(2) = "bII"

Degre$(3) = "II"

Degre$(4) = "bIII"

Degre$(5) = "III"

Degre$(6) = "IV"

Degre$(7) = "bV"

Degre$(8) = "V"

Degre$(9) = "bVI"

Degre$(10) = "VI"

Degre$(11) = "bVII"

Degre$(12) = "VII"

Dim Note1$(12)

Note1$(1) = "C"

Note1$(2) = "Db"

Note1$(3) = "D"

Note1$(4) = "Eb"

Note1$(5) = "E"

Note1$(6) = "F"

Note1$(7) = "Gb"

Note1$(8) = "G"

Note1$(9) = "Ab"

Note1$(10) = "A"

Note1$(11) = "Bb"

Note1$(12) = "B"

Dim Note2$(12)

Note2$(1) = "C"

Note2$(2) = "C#"

Note2$(3) = "D"

Note2$(4) = "D#"

Note2$(5) = "E"

Note2$(6) = "F"

Note2$(7) = "F#"

Note2$(8) = "G"

Note2$(9) = "G#"

Note2$(10) = "A"

Note2$(11) = "A#"

Note2$(12) = "B"

Dim ordre(12)

ordre(1) = 2

ordre(2) = 4

ordre(3) = 7

ordre(4) = 9

ordre(5) = 11

ordre(6) = 1

ordre(7) = 3

ordre(8) = 5

ordre(9) = 6

ordre(10) = 8

ordre(11) = 10

ordre(12) = 12

If Selection.Type = wdSelectionIP Then

MsgBox ("Veuillez sélectionner les accords à convertir en degrés")

End

End If

'supprime l'affichage en mode page pour ne pas perdre de temps avec la pagination

temp = ActiveWindow.View.Type

ActiveWindow.View.Type = wdNormalView

'Pour convertir le nom de l'accord en degré de 1 à 12

'1 pour C, 2 pour C#, 3 pour D ... 12 pour B

ton$ = InputBox$("Entrez la tonalité du morceau : ")

t = Asc(ton$) - 64

t = lettre_chiffre(t)

For i = 1 To Len(ton$)

If Mid$(ton$, i, 1) = "b" Then t = t - 1

If Mid$(ton$, i, 1) = "#" Then t = t + 1

Next i

t = -(t - 1) 'pour transposer du ton vers le degré I

'replace t entre 1 et 12

While (t <= 0)

t = t + 12

Wend

While (t >= 12)

t = t - 12

Wend

Selection.Find.ClearFormatting

Selection.Find.Font.Italic = False 'Ne modifie pas le texte en italique

Selection.Find.Font.Superscript = False 'Ni les altérations en exposant

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Forward = True

.Wrap = wdFindStop

.Format = True

.MatchCase = True

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Rem Remplace A - G par I - VII transposés

For i = 1 To 12

Result = ordre(i) + t

If Result > 12 Then Result = Result - 12

With Selection.Find

.Text = Note1$(ordre(i))

.Replacement.Text = Degre$(Result)

End With

Selection.Find.Execute Replace:=wdReplaceAll

If (i <= 5) Then 'Si l'accord

With Selection.Find

.Text = Note2$(ordre(i))

.Replacement.Text = Degre$(Result)

End With

Selection.Find.Execute Replace:=wdReplaceAll

End If

Next i

ActiveWindow.View.Type = temp

MsgBox ("Fini !")

End Sub