Ol� pessoal, estou com um grande problema, tenho algumas macros que foram
feitas no word, tentei importar as mesmas para o OpenOffice, mas n�o est�
funcionando.
Algu�m por gentileza poderia tentar modificar essas macros para que
funcionem no OpenOffice?
Obrigado desde j�.
Leandro Finger
Assistente T�cnico em Inform�tica
GD9 Acessoria em Recursos Humanos
(41) 363-5366.
www.gd9rh.com.br
Dim FSO, Arq_Texto
Dim Texto, sNome_Arq, sNome_Compl, sTipo, sLinha, sCvDoc, sCvIMG,
sPath_Anctemp, sCopia_Orig, sCopia_Dest As String
Dim iPos As Integer
Function SPA_Replace(sOrigem, sTroca_De, sTroca_Por)
Dim iPosicao As Integer, iTam_sOrigem, iTam_sTroca_De
Dim sDestino As String, sAntes_Marca, sDepois_Marca
iTam_sTroca_De = Len(sTroca_De)
iPosicao = 1
Do While iPosicao > 0
iTam_sOrigem = Len(sOrigem)
iPosicao = InStr(1, sOrigem, sTroca_De, 1)
If iPosicao > 0 Then
sAntes_Marca = ""
sDepois_Marca = ""
If iPosicao = 1 Then
sAntes_Marca = ""
sDepois_Marca = (Mid(sOrigem, (iTam_sTroca_De + 1), (iTam_sOrigem -
iTam_sTroca_De)))
Else
sAntes_Marca = (Left(sOrigem, (iPosicao - 1)))
sDepois_Marca = (Mid(sOrigem, (iPosicao + iTam_sTroca_De),
(iTam_sOrigem - (iPosicao + iTam_sTroca_De) + 1)))
End If
sDestino = (sAntes_Marca + sTroca_Por + sDepois_Marca)
Else
sDestino = sOrigem
End If
sOrigem = sDestino
Loop
SPA_Replace = sDestino
End Function
Function SPA_Replace_Line(sOrigem, sTroca_De, sTroca_Por)
Dim iPosicao As Integer, iTam_sOrigem, iTam_sTroca_De
Dim sDestino As String, sAntes_Marca, sDepois_Marca
iTam_sTroca_De = Len(sTroca_De)
iPosicao = 1
Do While iPosicao > 0
iTam_sOrigem = Len(sOrigem)
iPosicao = InStr(1, sOrigem, sTroca_De, 1)
If iPosicao > 0 Then
sAntes_Marca = ""
sDepois_Marca = ""
If iPosicao = 1 Then
sAntes_Marca = ""
sDepois_Marca = (Mid(sOrigem, (iTam_sTroca_De + 1), (iTam_sOrigem -
iTam_sTroca_De)))
Else
sAntes_Marca = (Left(sOrigem, (iPosicao - 1)))
sDepois_Marca = (Mid(sOrigem, (iPosicao + iTam_sTroca_De + 1),
(iTam_sOrigem - (iPosicao + iTam_sTroca_De) + 1)))
End If
sDestino = (sAntes_Marca + sTroca_Por + sDepois_Marca)
Else
sDestino = sOrigem
End If
sOrigem = sDestino
Loop
SPA_Replace_Line = sDestino
End Function
Sub Class_Auto()
' Classificar Macro
' Macro gravada 30/08/01 por AncoraRh
Open "c:\anctemp\spaclass.cfg" For Input As #1
Do While Not EOF(1)
Line Input #1, sLinha
sTipo = (Left(sLinha, 4))
sLinha = (SPA_Replace(sLinha, sTipo, ""))
If sTipo = "[00]" Then
sCvDoc = sLinha
End If
If sTipo = "[01]" Then
sCvIMG = sLinha
End If
If sTipo = "[02]" Then
sPath_Anctemp = sLinha
End If
Loop
Close #1
'Processo para excluir os arquivos caso eles tenham ficado na pasta da vez
anterior
Set sObj = CreateObject("Scripting.FileSystemObject")
'Exclui o Documento
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.DOC")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.DOC"), force
'Exclui o Documento no Formato Texto
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.TXT")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.TXT"), force
'Exclui o Arquivo de configuracao CLA
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.CLA")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.CLA"), force
'Exclui a Imagem
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.TIF")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.TIF"), force
'Rotina para criar o CLA do classificar auto
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Arq_Texto = FSO.CreateTextFile(sPath_Anctemp & "\CVINSERE.CLA", True)
SPA_Form4.t_Buffer.Text = ""
SPA_Form4.t_Buffer.Paste
Texto = SPA_Form4.t_Buffer.Text
Arq_Texto.WriteLine ("AUTO")
Arq_Texto.WriteLine ("CVAUTO")
Arq_Texto.WriteLine ("4.0")
Arq_Texto.WriteLine (Texto)
Arq_Texto.Close
' Processo para salvar o documento com texto e documento
ChangeFileOpenDirectory sPath_Anctemp
ActiveDocument.SaveAs FileName:="CVINSERE.DOC",
FileFormat:=wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveDocument.SaveAs FileName:="CVINSERE.TXT",
FileFormat:=wdFormatDOSText, LockComments:=False, Password:="",
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveDocument.Close
'Processo para minizar o Word
Application.WindowState = wdWindowStateMinimize
End Sub
Dim sNome_Arq, sNome_Compl, sTipo, sLinha, sCvDoc, sCvIMG, sPath_Anctemp,
sCopia_Orig, sCopia_Dest As String
Dim iPos As Integer
Dim iExiste As Boolean
Dim sObj
Function SPA_Replace(sOrigem, sTroca_De, sTroca_Por)
Dim iPosicao As Integer, iTam_sOrigem, iTam_sTroca_De
Dim sDestino As String, sAntes_Marca, sDepois_Marca
iTam_sTroca_De = Len(sTroca_De)
iPosicao = 1
Do While iPosicao > 0
iTam_sOrigem = Len(sOrigem)
iPosicao = InStr(1, sOrigem, sTroca_De, 1)
If iPosicao > 0 Then
sAntes_Marca = ""
sDepois_Marca = ""
If iPosicao = 1 Then
sAntes_Marca = ""
sDepois_Marca = (Mid(sOrigem, (iTam_sTroca_De + 1), (iTam_sOrigem -
iTam_sTroca_De)))
Else
sAntes_Marca = (Left(sOrigem, (iPosicao - 1)))
sDepois_Marca = (Mid(sOrigem, (iPosicao + iTam_sTroca_De),
(iTam_sOrigem - (iPosicao + iTam_sTroca_De) + 1)))
End If
sDestino = (sAntes_Marca + sTroca_Por + sDepois_Marca)
Else
sDestino = sOrigem
End If
sOrigem = sDestino
Loop
SPA_Replace = sDestino
End Function
Sub Class_Novo()
' Classificar Macro
' Macro gravada 30/08/01 por AncoraRh
Open "c:\anctemp\spaclass.cfg" For Input As #1
Do While Not EOF(1)
Line Input #1, sLinha
sTipo = (Left(sLinha, 4))
sLinha = (SPA_Replace(sLinha, sTipo, ""))
If sTipo = "[00]" Then
sCvDoc = sLinha
End If
If sTipo = "[01]" Then
sCvIMG = sLinha
End If
If sTipo = "[02]" Then
sPath_Anctemp = sLinha
End If
Loop
Close #1
sCvDoc = UCase(sCvDoc)
sCvIMG = UCase(sCvIMG)
'coloca o nome do arquivo sem extensao
sNome_Arq = ActiveDocument.Name
sNome_Arq = UCase(sNome_Arq)
sNomeArq = (SPA_Replace(sNome_Arq, ".DOC", ""))
'pega a path completa do arquivo
sNome_Compl = ActiveDocument.FullName
sNome_Compl = UCase(sNome_Compl)
'Processo para excluir os arquivos caso eles tenham ficado na pasta da vez
anterior
Set sObj = CreateObject("Scripting.FileSystemObject")
'Exclui o Documento
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.DOC")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.DOC"), force
'Exclui o Documento no Formato Texto
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.TXT")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.TXT"), force
'Exclui o Arquivo de configuracao CLA
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.CLA")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.CLA"), force
'Exclui a Imagem
iExiste = sObj.FileExists(sPath_Anctemp & "CVINSERE.TIF")
If iExiste Then sObj.DeleteFile (sPath_Anctemp & "CVINSERE.TIF"), force
'processo para salvar o documento com texto e documento
ChangeFileOpenDirectory sPath_Anctemp
ActiveDocument.SaveAs FileName:="CVINSERE.DOC",
FileFormat:=wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveDocument.SaveAs FileName:="CVINSERE.TXT",
FileFormat:=wdFormatDOSText, LockComments:=False, Password:="",
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveDocument.Close
'processo para cria o documento de classifica�ao normal
Application.Documents.Add
ActiveDocument.Content = "NORMAL"
ActiveDocument.Content.InsertParagraphAfter
ActiveDocument.Content.InsertAfter (sNomeArq)
ActiveDocument.Content.InsertParagraphAfter
ActiveDocument.Content.InsertAfter ("4.0")
ActiveDocument.SaveAs FileName:="CVINSERE.CLA",
FileFormat:=wdFormatDOSText, LockComments:=False, Password:="",
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveDocument.Close
'processo para copiar o arquivo da Cvimagem, e verifica se o documento veio
da Cvscanner
iPos = InStr(1, sNome_Compl, sCvDoc, vbTextCompare)
If iPos <> 0 Then
Set sObj = CreateObject("Scripting.FileSystemObject")
iExiste = sObj.FileExists(sCvIMG & sNome_Arq & ".TIF")
If iExiste Then
sObj.MoveFile (sCvIMG & sNome_Arq & ".TIF"), (sPath_Anctemp &
"CVINSERE.TIF")
sObj.DeleteFile sNome_Compl
End If
End If
Application.WindowState = wdWindowStateMinimize
End Sub
Sub SalvarSPA()
' Salvar Macro
' Macro gravada 27/05/01 por AncoraRh
SPA_form2.Show
End Sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
