Dúvida com macro "Salvar Como"

JVieira · April 7, 2022, 2:07pm

Olá! Estou tentando criar uma macro que, antes de limpar a tabela, crie uma cópia da planilha através do recurso “Salvar Como”. Porém, da forma como fiz, não está funcionando.
Poderiam, por gentileza, verificar o que há de errado?
Grato!

sub Limpar_Tabela
Dim Resposta as Integer
Resposta = MsgBox (“Você tem certeza? O navio já foi salvo?”, 36, “ATENÇÃO”)
If Resposta = 6 Then REM SE RESPOSTA SIM(6)
Call Salvar_como REM MACRO = Macro no caso Positivo (Sim)

else
end if
end sub

sub Salvar_como
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(“com.sun.star.frame.DispatchHelper”)

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = “ToPoint”
args1(0).Value = “$F$3”

dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:Copy”, “”, 0, Array())

rem ----------------------------------------------------------------------
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = “URL”
args3(0).Value = “file:///Y:/Comando/RELAT%C3%93RIO/TESTE%20-%20LUCKY%20LOONG.ods”
args3(1).Name = “FilterName”
args3(1).Value = “calc8”

dispatcher.executeDispatch(document, “.uno:SaveAs”, “”, 0, args3())

end sub
'-------------------------------------------------------------------------

sub Macro2
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(“com.sun.star.frame.DispatchHelper”)

'Bolacha 1
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = “ToPoint”
args1(0).Value = “$F$3:$F$6”
dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args1())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:ClearContents”, “”, 0, Array())

rem ----------------------------------------------------------------------
dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = “ToPoint”
args7(0).Value = “$P$2”
dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args7())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:ClearContents”, “”, 0, Array())

rem ----------------------------------------------------------------------
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = “ToPoint”
args8(0).Value = “$P$4”
dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args8())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:ClearContents”, “”, 0, Array())

rem ----------------------------------------------------------------------
dim args9(0) as new com.sun.star.beans.PropertyValue
args9(0).Name = “ToPoint”
args9(0).Value = “$B$10:$M$10”
dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args9())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:ClearContents”, “”, 0, Array())

rem ----------------------------------------------------------------------
dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = “ToPoint”
args11(0).Value = “$N$9:$P$10”
dispatcher.executeDispatch(document, “.uno:GoToCell”, “”, 0, args11())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, “.uno:ClearContents”, “”, 0, Array())

schiavinatto · April 7, 2022, 3:40pm

Ola @JVieira , segue uma macro para Salvar como com informações do Diretório e nome do arquivo em células.

Necessário completar, conforme sua necessidade.

TestesSalvar.ods (9.9 KB)


'' Salvar Como Arquivo Pasta Celula = Sub SalvarComo
Sub SalvarComo
' PEGAR NOME PASTA
	CELL_PASTA = "Planilha1.A1"
    FOLDER = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(CELL_PASTA)
' PEGAR NOME ARQUIVO 
    CELL_ARQ = "Planilha1.A2"
    ARQ = ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(CELL_ARQ)
' SALVAR COMO
    path = ConvertToURL(FOLDER.String + ARQ.String + ".ods")
Dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = path 'DirFile 
args1(1).Name = "FilterName"
args1(1).Value = "calc8"
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController _
.Frame, ".uno:SaveAs", "", 0, args1())
End Sub

Caso queira, poste seu arquivo modelo, para adaptar a macro.

FelipeAle · April 7, 2022, 5:02pm

–EDITADO–

REM -----------------------------------------------------------------------------
Sub LimparTabela()

	If MsgBox ("Você tem certeza? O navio já foi salvo?", 256+4, UCase("Atenção")) = 6 Then
		call SalvarComo
	Else
		Exit Sub
	End If

End Sub


REM -----------------------------------------------------------------------------
Sub SalvarComo()
rem Define variáveis
Dim sUrl as String
	
	rem O erro na descrição do caminho/diretório
	rem Recomencações:
	rem 	Ao nomear pastas, NÃO use acento, NÃO USE ESPAÇO.
	rem Exempplo ideal:
	rem		Y:\Comando\RELATORIO\TESTE_LUCKY-LOONG.ods
	sUrl = ConvertToUrl("Y:\Comando\RELATÓRIO\TESTE - LUCKY LOONG.ods")
	
	call fnDispatch ("GoToCell", Array("ToPoint", "$F$3")) : call fnDispatch ("Copy")
	call fnDispatch ("SaveAs", Array("URL", sUrl, "FilterName", "calc8") )
	
End Sub

REM -----------------------------------------------------------------------------
Sub ClearContents()
	rem Invoca a função do Dispatcher para apagar qualquer dado nos respectivos intervalos
	rem	Exemplo GoToCell -> fnDispatch ("GoToCell", Array("ToPoint", "<<PREENCHA AQUI O INTERVALO/CELULA QUE DESEJA APAGAR>>"))
	call fnDispatch ("GoToCell", Array("ToPoint", "$F$3:$F$6")) : call fnDispatch ("ClearContents")
	call fnDispatch ("GoToCell", Array("ToPoint", "$P$2")) : call fnDispatch ("ClearContents")
	call fnDispatch ("GoToCell", Array("ToPoint", "$P$4")) : call fnDispatch ("ClearContents")
	call fnDispatch ("GoToCell", Array("ToPoint", "$B$10:$M$10")) : call fnDispatch ("ClearContents")
	call fnDispatch ("GoToCell", Array("ToPoint", "$N$9:$P$10")) : call fnDispatch ("ClearContents")
End Sub



REM ============================================================ FUNÇÕES

''' Para simplicar o codigo principal usando uma funcao que percorre todos os comandos acessíveis pelo frame
''' Para ser utilizada corretamente é necessário gravar uma macro e verificar os argumentos que foram criados.
''' Feito isso, na macro principal, você chama a função inserindo o Comando e os argumentos iguais aos que foram gravados
Function fnDispatch( pComando$, Optional pMyArgs )
'''	Parâmetros:
'''		pComando: Comando em texto
'''		pMyArgs: argumentos/propriedades
'''	Exemplo de uso:
'''		Sub Main()
'''			REM Sem argumentos
'''			Call fnDispatch("SelectAll")
'''			REM Com argumentos
'''			Call fnDispatch("FontHeight", Array("FontHeight.Height", 12, "FontHeight.Prop", 100, "FontHeight.Diff", 0) )
'''			Call fnDispatch("JustifyPara", Array("JustifyPara", true) )
'''		End Sub

''' Define variáveis
Dim oFrame as Object		'P/ obter o Frame
Dim oDispatcher as Object	'P/ instanciar o serviço de gravador
Dim nArgs as Variant		'P/ os argumentos (Name, Value)
Dim i as Long				'P/ fazer a leitura dos argumentos
	
	'Obtem o frame
	oFrame   = ThisComponent.getCurrentController.getFrame
	'Instacia o serviço
	oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

On Error Resume Next
	'Se não existir argumentos, executar comando sem argumentos
	'Se existir, invoca API para definir as propriedades, faz a leitura do conjunto, e executa o comando
	If isMissing (pMyArgs) then
		fnDispatch = oDispatcher.executeDispatch(oFrame, ".uno:" & pComando, "", 0, array() )
	Else
		nArgs = UBound(pMyArgs) \ 2
		
		Dim Args(nArgs) as New com.sun.star.beans.PropertyValue
		For i = 0 To nArgs
			Args(i).Name = pMyArgs(i * 2)
			Args(i).Value = pMyArgs(i * 2 + 1)
		Next i
		fnDispatch = oDispatcher.executeDispatch(oFrame, ".uno:" & pComando, "", 0, Args() )
	End if
End Function	'MinhaColetanea.Macros_DispatcherFunction.fnDispatch

.
COMPLEMENTO
SalvarCopiaAsk_JVieira.ods (161,3,KB)

.
Segue codigo para fins de registro

REM -----------------------------------------------------------------------------
Sub SalvarCopiaDoArquivo(Optional pSheet as Object)

Dim sUrl As String
Dim sPath As String
Dim sSourceName As String
Dim sTargetName As String

	rem Carrega a biblioteca Tools
	GlobalScope.BasicLibraries.LoadLibrary("Tools")

	rem Se planilha não definida, obtem a ativa
	If isMissing(pSheet) then pSheet = ThisComponent.getCurrentController().getActiveSheet()
	
	rem Url do arquivo
	sUrl = ConvertFromUrl( ThisComponent.getUrl() )
	rem Retorna todo o caminho, sem o nome do arquivo
	sPath = DirectoryNameOutofPath(sUrl, GetPathSeparator() )
	rem Obtem o nome preenchido na célula F3 para renomear o arquivo
	sSourceName = pSheet.getCellRangeByName("$Plan5.$F$3").getString()
	rem 	Retorna a Url com o nome novo
	rem sTargetName = sPath & GetPathSeparator() & sSourceName & ".ods" '<<USADO PARA TESTAR>>>
	sTargetName = "Y:\Comando\RELATORIO" & GetPathSeparator() & sSourceName & ".ods"
	rem Verifica se arquivo já existe
	rem Se não, cria o novo
	If FileExists( sTargetName ) then
		MsgBox "Arquivo já existe. Por favor, verifique a pasta."
	Else
		FileCopy(sUrl, sTargetName)
	End If

End Sub

JVieira · April 7, 2022, 5:55pm

Boa tarde, Felipe!

Ao executar a macro aparece a seguinte mensagem: “Erro de execução do Basic. Procedimento Sub ou procedimento de Function não definido”, e essa parte do código fica grifada: “fnDispatch (“GoToCell”, Array(“ToPoint”, “$F$3”)) :”

FelipeAle · April 7, 2022, 7:13pm

Tente utilizar a seguinte Instrução antes da função

Call fnDispatch (“GoToCell”, Array(“ToPoint”, “$F$3”))

JVieira · April 12, 2022, 2:10pm

Senhores, infelizmente esta solução não atendeu minha necessidade, porque quando usamos o evento Salvar Como, a planilha principal é fechada e fica ativa a cópia criada. Preciso que seja feita uma cópia (de forma oculta) da planilha, porém a planilha principal deve permanecer ativa.
Vou detalhar minha necessidade para que possam verificar se é possível atendê-la.

O código deve ser mais ou menos assim:

Seleciona a célula F3 da Plan5
Copia conteúdo da célula F3.
Chama o evento “Salvar uma Cópia” (ou equivalente).
Salva a planilha com o nome copiado da F3 na pasta “Relatorio”.

Desde já agradeço.

FelipeAle · April 12, 2022, 4:38pm

Tendo em vista o que pede, será necessário que anexe arquivo exemplo. Se houverem dados sensíveis, anexe uma cópia sem estes dados

JVieira · April 12, 2022, 4:56pm

Segue planilha.
TESTE.ods (159.9 KB)

FelipeAle · April 13, 2022, 3:21am

@JVieira
Vide complemento, com seu arquivo modificado e inserção da macro para salvar copia do com novo nome, sem fechar arquivo em uso.

Por favor, se a resposta lhe atender, não deixe de marcar como Solução, a fim de auxiliar novos usuários.

JVieira · April 13, 2022, 11:28am

Bom dia, Felipe!

O código está travando na linha 41 com a seguinte msg: “Erro de execução do BASIC. Arquivo não encontrado.”

FelipeAle · April 13, 2022, 12:32pm

Corrigido.
Vide:

JVieira · April 13, 2022, 1:04pm

Perfeito, Felipe!

Muito obrigado!