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”
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”)
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!
Comentários Recentes