Voila mon fichier de macros VC. Mais bientot je pourrais le mettre a la poubelle car je suis en train d'ecrire un systeme d'extension en python a VC :-)
Sub SomeLineUp()
'DESCRIPTION: Move some lines up
on error resume next
ActiveDocument.Selection.LineUp dsMove,5
End Sub
Sub SomeLineDown()
'DESCRIPTION: Move some lines down
on error resume next
ActiveDocument.Selection.LineDown dsMove, 5
End Sub
Sub CleanBuild()
'DESCRIPTION: Enleve tous les fichiers intermediaires puis build le projet
Clean ActiveConfiguration
Build
End Sub
Sub VireInutile()
'DESCRIPTION: Enleve les espaces en fin de ligne
'Par le pouvoir de la Reg-Exp !!! Je reclame le Replace tout puissant !!!
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
ActiveDocument.Selection.SelectAll
ActiveDocument.Selection.ReplaceText "\:b*$", "", dsMatchRegExp
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
Sub OemToANSI()
'DESCRIPTION: Convertit un texte OEM en ANSI
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
ActiveDocument.Selection.SelectAll
ActiveDocument.Selection.ReplaceText chr(130), "é"
ActiveDocument.Selection.ReplaceText chr(138), "è"
ActiveDocument.Selection.ReplaceText chr(147), "ô"
ActiveDocument.Selection.ReplaceText chr(136), "ê"
ActiveDocument.Selection.ReplaceText chr(133), "à"
ActiveDocument.Selection.ReplaceText chr(131), "â"
ActiveDocument.Selection.ReplaceText chr(248), "°"
ActiveDocument.Selection.ReplaceText chr(196), "-"
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
Dim clipboard(64)
Dim cliplines
cliplines=-1
clipboard(0) = ""
Sub StackClipboardCut()
'DESCRIPTION: Performs a cut of current selection into LIFO stack
if(cliplines<63) then
cliplines=cliplines+1
clipboard(cliplines)=ActiveDocument.Selection.Text
ActiveDocument.Selection.Text=""
end if
End Sub
Sub StackClipboardCopy()
'DESCRIPTION: Performs a copy of current selection into LIFO stack
if(cliplines<63) then
cliplines=cliplines+1
clipboard(cliplines)=ActiveDocument.Selection.Text
end if
End Sub
Sub StackClipboardPaste()
'DESCRIPTION: Performs a paste of top LIFO stack entry into current selection
if(cliplines>-1) then
ActiveDocument.Selection=clipboard(cliplines)
cliplines=cliplines-1
else
ActiveDocument.Selection=clipboard(0)
end if
End Sub
Sub InverseAffect()
'DESCRIPTION: Inverse les membres gauche et droite d'affectation ( selectionner les affectations )
ActiveDocument.Selection.ReplaceText _
"\([^ ]*\)\:b*=\:b*\([^ ;]*\)", "\2 = \1", dsMatchRegExp
'"\(\:i\)\:b*=\:b*\(\:i\)", "\2 = \1", dsMatchRegExp _
End Sub
Sub InsereLigne()
'DESCRIPTION: Insere au debut de chaque ligne de la selection un texte
if ActiveDocument.Selection.TopLine = ActiveDocument.Selection.BottomLine then
exit sub
end if
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
texte = inputbox("Quel texte voulez vous ajoutez au debut de chaque ligne de la selection ?", "Ajout d'un texte en debut de lignes" )
if Len(texte)=0 then
exit sub
end if
ActiveDocument.Selection.ReplaceText "^",texte, dsMatchRegExp
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
Sub CommenteBloc()
'DESCRIPTION: Commente une selection
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
ActiveDocument.Selection.ReplaceText "^\:b*//\:b*","", dsMatchRegExp
ActiveDocument.Selection.ReplaceText "^","//", dsMatchRegExp
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
Sub LignesNumerotees()
'DESCRIPTION: Ecris une suite de lignes numerotees
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
tmp = InputBox("Combien de lignes voulez-vous creer ?", "Entree de lignes" )
if Len(tmp)=0 then
exit sub
end if
cnt = InputBox("Combien de textes par ligne ? (au moins 1)", "Entree de lignes" )
if (cnt<1) then
Msgbox cnt + " n'est pas une valeur valide ! Reessayez !"
exit sub
end if
NbLignes = CInt(tmp)
texte = InputBox("Quel texte voulez-vous entrer ?", "Entree de lignes" )
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
Ajout = ""
for Cpt1 = 0 to NbLignes
' ActiveDocument.Selection.Text = texte + CStr(Cpt1) + "," + chr(13)
if (Cpt1<10) then
autre = " "
else
autre = ""
end if
if ((Cpt1+1) mod Cnt) <> 0 then
Ajout = Ajout + texte + CStr(Cpt1) + ", " + autre
else
Ajout = Ajout + texte + CStr(Cpt1) + "," + autre + chr(13)
end if
next
ActiveDocument.Selection.Text = Ajout
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
Sub Indentator()
'DESCRIPTION: Indentator, il va tout vous indenter !!!
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
if (ActiveDocument.Selection.BottomLine=ActiveDocument.Selection.TopLine) then
ActiveDocument.Selection.SelectAll
end if
premier = ActiveDocument.Selection.TopLine
max_ligne = ActiveDocument.Selection.BottomLine
Application.visible = false
ActiveDocument.Selection.MoveTo 0,0
for Cpt1=premier to max_ligne
ActiveDocument.Selection.MoveTo Cpt1, 1
ActiveDocument.Selection.SmartFormat
ActiveDocument.Selection.LineDown
next
Application.visible = true
ActiveDocument.Selection.MoveTo curr_ligne, curr_col
End Sub
' This will assisgn resource ID's to the selected block by starting
' with the resource ID given and then incrementing until the end of
' the selection is reaced.
' (Uncomment the commented lines to process only sourcecode files)
Sub AssignResourceIDToSelection()
msg = InputBox ("Enter The resource ID to start From:" )
' TypeOfFile = FileType(ActiveDocument)
' if TypeOfFile <> dsCPP Then
' MsgBox "File Must be of type .c, .cpp, .cxx, .h, .hpp, .hxx"
' Else
If msg <> "" Then
If IsNumeric(msg) Then
nCurResourceID = Int(msg)
AssignGivenResourceIDToSelection(nCurResourceID)
End If
Else
MsgBox "You MUST enter a resource ID, Aborting"
End If
' End if
End Sub
'This function can be integrated with other macros to
'automate the renumbering of resource ID's
Function AssignGivenResourceIDToSelection (ByVal nCurResourceID)
nStartLine = ActiveDocument.Selection.TopLine
nEndLine = ActiveDocument.Selection.BottomLine
' Debugging messageBox
' MsgBox "Start:" + CStr(nStartLine) + " End:" + + CStr(nEndLine)
For i = nStartLine To nEndLine
ActiveDocument.Selection.GoToLine i
ActiveDocument.Selection.FindText "#define", dsMatchForward
If ActiveDocument.Selection.CurrentLine = i Then
' Debugging messageBox
' MsgBox "Ext:" + CStr(ActiveDocument.Selection.CurrentLine)
ActiveDocument.Selection.EndOfLine
ActiveDocument.Selection.WordLeft dsExtend
ActiveDocument.Selection = nCurResourceID
nCurResourceID = nCurResourceID + 1
End if
Next
End Function
Sub DocumentName()
'DESCRIPTION: Affiche le nom d'un document
msgbox Application.ActiveDocument.FullName
End Sub
Sub TrueFalse()
'DESCRIPTION: A description was not provided.
Application.visible = false
windows.CloseAll
Documents.Open ActiveProject.FullName, "Text"
ActiveDocument.Selection.MoveTo 1,1
line = 0
do while(ActiveDocument.Selection.FindText("SOURCE=.*\{\.h\!\.c\!\.cpp\}$", dsMatchRegExp)=true)
if (line>=ActiveDocument.Selection.CurrentLine) then
exit do
end if
TrueFalseFile(ActiveDocument.Selection.Text)
line = ActiveDocument.Selection.CurrentLine
Loop
ActiveDocument.Close
Application.visible = true
MsgBox "BOOL, TRUE et FALSE, mis a jour !"
End Sub
sub TrueFalseFile(filename)
filename = mid(filename, 8) ' vire SOURCE=
Documents.Open filename
ActiveDocument.Selection.SelectAll
ActiveDocument.Selection.ReplaceText "true", "TRUE", dsMatchWord
ActiveDocument.Selection.SelectAll
ActiveDocument.Selection.ReplaceText "false", "FALSE", dsMatchWord
ActiveDocument.Selection.SelectAll
ActiveDocument.Selection.ReplaceText "bool", "BOOL", dsMatchWord
ActiveDocument.Close
end sub
Sub MyNextLine()
'DESCRIPTION: A description was not provided.
ActiveDocument.Selection.SmartFormat
ActiveDocument.Selection.LineDown
End Sub
Sub MyPreviousLine()
'DESCRIPTION: A description was not provided.
ActiveDocument.Selection.SmartFormat
ActiveDocument.Selection.LineUp
End Sub
Sub OuvreSourcesDuProjet()
'DESCRIPTION: Ouvre tous les fichiers sources d'un projet
windows.CloseAll
Documents.Open ActiveProject.FullName, "Text"
set dsp = ActiveDocument
dsp.Selection.MoveTo 1,1
line = 0
do while(dsp.Selection.FindText("SOURCE=.*\{\.h\!\.c\!\.cpp\}$", dsMatchRegExp)=true)
if (line>=dsp.Selection.CurrentLine) then
exit do
end if
Documents.Open mid(dsp.Selection.Text, 8)
line = dsp.Selection.CurrentLine
Loop
dsp.close
End Sub
Sub superif()
'DESCRIPTION: Insere un "if"
ActiveDocument.Selection.Text = "if (){" + chr(13) + "}"
ActiveDocument.Selection.MoveTo ActiveDocument.Selection.CurrentLine-1, 1, dsExtend
ActiveDocument.Selection.SmartFormat
ActiveDocument.Selection.FindText "("
ActiveDocument.Selection.MoveTo ActiveDocument.Selection.CurrentLine, ActiveDocument.Selection.CurrentColumn
ActiveDocument.Selection.SmartFormat
End Sub
private function CompteLignesDeCodeInFile(filename)
length = 0
Documents.Open filename
ActiveDocument.Selection.SelectAll
length = ActiveDocument.Selection.BottomLine
ActiveDocument.Close
CompteLignesDeCodeInFile = length
end function
Sub EnterBug()
'DESCRIPTION: "Solve" the ENTER-bug !
ActiveDocument.Selection.Text = chr(13)
End Sub
Sub FabOneTimeInclude()
'DESCRIPTION: Include a header ONE time
On Error Resume Next
dim name
name = ActiveDocument.Name
if Right(name, 2) <> ".h" then
exit sub
end if
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn
ActiveDocument.Selection.StartOfDocument
dim Id
Id = "__" + UCase(Left(name, Len(name)-2)) + "_H__"
ActiveDocument.Selection.Text = "#ifndef " + Id + chr(13) _
+ "#define " + Id + chr(13) + chr(13)
ActiveDocument.Selection.EndOfDocument
ActiveDocument.Selection.Text = chr(13) + chr(13) + "#endif // " + Id
ActiveDocument.Selection.MoveTo curr_ligne + 3, curr_col
End Sub
Sub RemoveFalseTab()
'DESCRIPTION: A description was not provided.
curr_ligne = ActiveDocument.Selection.CurrentLine
curr_col = ActiveDocument.Selection.CurrentColumn-1
if curr_col=0 then exit sub
char_left = curr_col mod 4
if char_left=0 then char_left=4
PrintToOutputWindow char_left
ActiveDocument.Selection.MoveTo curr_ligne, curr_col-char_left+1, dsExtend
ActiveDocument.Selection.Text = RTrim(ActiveDocument.Selection.Text)
End Sub
Private sub DoMakeBuildDate()
ActiveProject.AddFile "buildate.h"
DoBeforeBuildStart()
end sub
sub MakeBuildDate()
On Error Resume Next
DoMakeBuildDate()
end sub
Private sub DoBeforeBuildStart()
Documents.Open "buildate.h"
ActiveDocument.Selection = "#define BUILD_DATE "
ActiveDocument.Save()
FabOneTimeInclude()
end sub
sub dummyApplication_BeforeBuildStart()
On Error Resume Next
DoBeforeBuildStart()
end sub
private Sub DoSelLen()
msgbox len(ActiveDocument.Selection), vbOKOnly+vbInformation, "Selection len"
end sub
Sub SelLen()
'DESCRIPTION: A description was not provided.
on error resume next
DoSelLen()
End Sub
start = 0
sub Application_BeforeBuildStart()
start = Now
end sub
sub Application_BuildFinish(nNumErrors, nNumWarnings)
t = DateDiff("s", start, Now)
sss = int(t mod 60)
mmm = int((t/60) mod 60)
hhh = int(t/3600)
res = "Build done in "
if hhh>0 then
res = res & cstr(hhh) & "h " & cstr(mmm) & "mn " & cstr(sss) & "s"
else
if mmm>0 then
res = res & cstr(mmm) & "mn " & cstr(sss) & "s"
else
res = res & cstr(sss) & "s"
end if
end if
PrintToOutputWindow res
end sub
Sub ToggleSource()
'DESCRIPTION: toggle between .h and .cpp
filename = None
if lcase(right(ActiveDocument.Name, 2))=".h" then
'on error resume next
filename = left(ActiveDocument.FullName, len(ActiveDocument.FullName)-2)+".cpp"
Documents.Open(filename)
elseif lcase(right(ActiveDocument.Name, 4))=".cpp" then
'on error resume next
filename = left(ActiveDocument.FullName, len(ActiveDocument.FullName)-4)+".h"
Documents.Open(filename)
end if
if filename<>None then
for each cpt in documents
if cpt.FullName=filename then
cpt.active = 1
exit for
end if
next
end if
End Sub