Acordium: Um programa em VBA para Word2007 que torna um documento em Word de acordo com o Acordo Ortográfico de 1990

Public mudadas As Long
Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” _
(pOpenfilename As OpenFileName) As Long

Private Type OpenFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Sub AutoOpen()

Application.ScreenUpdating = False
‘ turns off screen updating
Application.DisplayStatusBar = True
‘ makes sure that the statusbar is visible
Application.StatusBar = “Acordium – Um programa do http://www.movimentolusofono.org”

MsgBox “Vai ser executado o Acordium Versão 1001 – Um programa oferecido pelo MIL” & Chr(13) & Chr(13) & “(Movimento Internacional Lusófono – http://www.movimentolusofono.org)” & Chr(13) & Chr(13) & “Para facilitar a conversão de documentos em Word para a nova norma do Acordo Ortográfico de 1990.” & Chr(13) & Chr(13) & “Este programa usa uma tabela válida apenas para a norma lusoafricana, não para a norma culta brasileira.”

Call AcordiumVer1001
End Sub

Sub AcordiumVer1001()

Call MainAcordium

Application.StatusBar = False

End Sub

Function BrowseForFile(sInitDir As String, _
Optional ByVal sFileFilters As String, _
Optional sTitle As String = “Open File”, _
Optional lParentHwnd As Long) As String

Dim tFileBrowse As OpenFileName
Const clMaxLen As Long = 254

tFileBrowse.lStructSize = Len(tFileBrowse)

‘Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, “|”, vbNullChar)
sFileFilters = Replace(sFileFilters, “;”, vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
‘Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If

‘Select a filter
tFileBrowse.lpstrFilter = sFileFilters & _
“All Files (*.*)” & vbNullChar & “*.*” _
& vbNullChar
‘create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, ” “)
‘set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
‘Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
‘Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
‘Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
‘Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
‘Set the title
tFileBrowse.lpstrTitle = sTitle

‘No flags
tFileBrowse.flags = 0

‘Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
‘Remove trailing null
BrowseForFile = Left$(BrowseForFile, _
Len(BrowseForFile) – 1)
End If
End If
End Function

Sub MainAcordium()

Const ForReading = 1, ForWriting = 2
mudadas = 0

Set fso = CreateObject(“Scripting.FileSystemObject”)

Set TabelaAcordo1990 = fso.OpenTextFile(“c:\tabelaacordo1990.txt”, ForReading)
Set LogAcordo1990 = fso.CreateTextFile(“c:\Logacordo1990.txt”)
LogAcordo1990.Close

Dim WordCount As Long
Dim myRange As Range

Documents.Open FileName:=BrowseForFile(“c:\”, “Ficheiro Word 2000/2007 (*.*);*.*”, “Abrir Documento”), ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:=””, _
PasswordTemplate:=””, Revert:=False, WritePasswordDocument:=””, _
WritePasswordTemplate:=””, Format:=wdOpenFormatAuto, XMLTransform:=””

Set myRange = ActiveDocument.Range

Selection.HomeKey Unit:=wdStory
totalpalavras = myRange.ComputeStatistics(wdStatisticWords)

Do Until TabelaAcordo1990.AtEndOfStream

ReadLineTextFile = TabelaAcordo1990.ReadLine
arrServiceList = Split(ReadLineTextFile, “;”)

de = arrServiceList(0)
para = arrServiceList(1)

Call FindReplace(de, para)

Loop

Set r2LogAcordo1990 = fso.OpenTextFile(“c:\LogAcordo1990.txt”, 8)

perc = mudadas * 100 / totalpalavras

perc = Round(perc, 2)

r2LogAcordo1990.WriteLine (“Total de Palavras neste documento: ” & CStr(totalpalavras))
r2LogAcordo1990.WriteLine (“Palavras adaptadas consoante Acordo de 1990: ” & CStr(mudadas))
r2LogAcordo1990.WriteLine (“Percentagem de palavras adaptadas consoante Acordo de 1990: ” & CStr(perc) & “%”)

r2LogAcordo1990.Close

Documents.Open FileName:=”c:\Logacordo1990.txt”, ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:=””, _
PasswordTemplate:=””, Revert:=False, WritePasswordDocument:=””, _
WritePasswordTemplate:=””, Format:=wdOpenFormatAuto, XMLTransform:=””

MsgBox “Fim de Execução do Acordium! Foram convertidas ” & CStr(mudadas) & ” palavra(s)” & Chr(13) & Chr(13) & “Tem agora aberto o ficheiro de registo de execução <LogAcordo1990.txt> com as alterações e percentagem das mesmas.” & Chr(13) & Chr(13) & “Tem também aberto o documento Word onde estas foram aplicadas. Se as aceitar, grave o documento com Save ou SaveAs.” & Chr(13) & Chr(13) & ” Acordium1001 – Um programa gratuito produzido pelo MIL (Movimento Internacional Lusófono) ” & Chr(13) & Chr(13) & ” http://www.movimentolusofono.org&#8221;

Set objShell = CreateObject(“Wscript.Shell”)

intMessage = MsgBox(“Que visitar a página do MIL – Movimento Lusófono que criou este programa?”, _
vbYesNo, “Access Denied”)

If intMessage = vbYes Then
objShell.Run (“http://www.movimentolusofono.org&#8221;)
End If

End Sub

Sub FindReplace(de, para)

Set fso = CreateObject(“Scripting.FileSystemObject”)
Const ForReading = 1, ForWriting = 2

primeira = “sim”

Set rLogAcordo1990 = fso.OpenTextFile(“c:\LogAcordo1990.txt”, 8)

Selection.HomeKey Unit:=wdLine
Application.StatusBar = “Procurando por: <” & para & “>”
While Selection.Find.Found = True Or primeira = “sim”

With Selection.Find
.Text = de
.Replacement.Text = para

.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceOne

primeira = “não”

Selection.Find.Forward = True
Selection.Find.Wrap = wdFindStop

Selection.HomeKey Unit:=wdLine

If Selection.Find.Found = True Then

mudadas = mudadas + 1
rLogAcordo1990.WriteLine (“De: <” & de & “> Para: <” & para & “>”)
End If
Wend

rLogAcordo1990.Close

End Sub

Recordo entretanto que esta Petição continua a recolher assinaturas!

Anúncios