Segue abaixo. Há uns problemas:
- pela lógica da macro que peguei original, ela gera um slide por vez,
apagando temporariamente os outros. Isso causa problema se o numero do
slide aparecer na tela (vai sair sempre como 1)
- deve haver algum bug de memoria do Libreoffice, pois testei numa
pasta com varias apresentacoes (cada uma com uns 30 slides), e ele
"abortou" durante a 3a. apresentacao. Não deu nem erro: simplesmente
parou e fechou o programa. Mas nao parece problema da macro
Não testei mais, mas para o que precisava, ficou ótimo.
[]s
REM ***** BASIC *****
Sub gerarMiniImpress
' Macro para gerar arquivo JPG de cada slide de varias apresentacoes
numa pasta
'
-----------------------------------------------------------------------------
dim pathArquivo as string
pathArquivo =
"C:\Users\Usuario\Documents\AAGilvan\Empresa\UniFeso\Disciplinas\HCC\Aulas\"
nomeArquivo = Dir(pathArquivo + "*.odp") 'Acessa pasta e pega o
primeiro arquivo
Do While (nomeArquivo <> "") ' Repete enquando houver arquivo na pasta
docAnalisado = pathArquivo + nomeArquivo
' Abre documento para descobrir quantas paginas possui
oDoc = abreDocumento( docAnalisado )
numPaginas = oDoc.getDrawPages().getCount()
' Apos descobrir, fecha sem salvar
oDoc.dispose()
' Pega nome do documento, mas sem a extensao (sufixo)
docAnalisadoSemSufixo = Left(docAnalisado, Len(docAnalisado) - 4)
' Faz laco para percorrer cada pagina
For j = 0 To numPaginas - 1
' Abre documento
oDoc = abreDocumento(docAnalisado)
' Apaga todas as paginas, menos a que interessa
apagarPaginasExceto(oDoc, j)
' Cria o nome do arquivo a salvar
novoNome = docAnalisadoSemSufixo + "-Thumb" + CSTR(j+1)
' Exporta como JPG
exportarParaJPG( oDoc, novoNome )
' Fecha sem salvar
oDoc.dispose()
Next j
nomeArquivo = Dir() 'Pega o proximo arquivo
Loop
End Sub
Function abreDocumento( docAux )
' Abre documento Impress
Dim args(0) As New com.sun.star.beans.PropertyValue
' Define a propriedade Hidden como TRUE para abrir escondido
args(0).Name = "Hidden"
args(0).Value = TRUE
oDoc = StarDesktop.LoadComponentFromURL( ConvertToURL( docAux ),
"_blank", 0, args() )
' Retorna com doc
abreDocumento() = oDoc
End Function
Sub apagarPaginasExceto( oDoc, paginaManter )
numPaginas = oDoc.getDrawPages().getCount()
maiorPagina = numPaginas - 1 ' Pois 10 paginas vai de 0 a 9
' Delete the last page, then the page before that,
' then the page before that, until we get to the
' page to keep.
' This deletes all pages AFTER the page to keep.
paginaApagar = maiorPagina
Do While paginaApagar > paginaManter
' Pega a pagina
oPage = oDoc.getDrawPages().getByIndex( paginaApagar )
' Remove a pagina
oDoc.getDrawPages().remove( oPage )
paginaApagar = paginaApagar - 1
Loop
' Delete all the pages before the page to keep.
For i = 0 To paginaManter - 1
' Delete the first page.
paginaApagar = 0
' Get the page.
oPage = oDoc.getDrawPages().getByIndex( paginaApagar )
' Tell the document to remove it.
oDoc.getDrawPages().remove( oPage )
Next i
End Sub
Sub exportarParaJPG( oDoc, cFilename )
Dim sFileUrl As String
sFileUrl = ConvertToURL( cFilename + ".jpg" )
oDrawPage = oDoc.getDrawPages().getByIndex(0)
'creating filter data
Dim aFilterData (7) as new com.sun.star.beans.PropertyValue
'properties valid for all filters
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = 320 'oDrawPage.Width*(72/2540) 'convert =>
mm => inches => pixels (72 points per inch)
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = 240 'oDrawPage.Height*(72/2540) 'convert =>
mm => inches => pixels (72 points per inch)
'filter data for the image/jpeg MediaType
aFilterData(2).Name = "Quality"
aFilterData(2).Value = 90
aFilterData(3).Name = "ColorMode"
aFilterData(3).Value = 0
'filter data for the image/png MediaType
'aFilterData(2).Name ="Compression"
'aFilterData(2).Value = 9
'aFilterData(3).Name ="Interlaced"
'aFilterData(3).Value = 0
'filter data for the image/gif MediaType
'aFilterData(2).Name ="Translucent"
'aFilterData(2).Value = true
'aFilterData(3).Name ="Interlaced"
'aFilterData(3).Value = 0
'filter data for the image/bmp MediaType
'aFilterData(2).Name ="Color"
'aFilterData(2).Value = 7
'aFilterData(3).Name ="ExportMode"
'aFilterData(3).Value = 0
'aFilterData(4).Name ="Resolution"
'aFilterData(4).Value = 300
'aFilterData(5).Name ="RLE_Coding"
'aFilterData(5).Value = true
'aFilterData(6).Name ="LogicalWidth"
'aFilterData(6).Value = 2000
'aFilterData(7).Name ="LogicalHeight"
'aFilterData(7).Value = 2000
Dim aArgs (2) as new com.sun.star.beans.PropertyValue
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/jpeg"
aArgs(1).Name = "URL"
aArgs(1).Value = sFileUrl
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData()
xExporter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )
xExporter.setSourceDocument( oDrawPage )
xExporter.filter( aArgs() )
End Sub
Em 24 de julho de 2012 07:48, DenisDobbin <[email protected]> escreveu:
> oi Gilvan,
>
> se puder, posta ai... seria interessante ver esse codigo...
>
>
> [ ]'s
>
>
>
>
> Denis Dobbin
> -------------------
>
>
>
> ________________________________
> De: Gilvan Vilarim <[email protected]>
> Para: [email protected]
> Enviadas: Segunda-feira, 23 de Julho de 2012 20:49
> Assunto: Re: [pt-br-usuarios] RESOLVIDO: Gerar miniaturas de apresentacao
>
> Uau, consegui resolver. Fucei na net umas macros e descobri como ler
> varios arquivos dentro de uma pasta. Consegui entao adaptar para mim e
> fazer o seguinte: minha macro pega todos os arquivos de apresentacao
> que eu tiver numa pasta, e gera um arquivo JPG para cada slide de cada
> apresentacao.
>
> Ficou bem legal; tá misturando um pouco de ingles com portugues no
> código mas funciona. Se algum usuário que programa macros quiser, me
> avise que eu mando o codigo.
>
> []s
>
--
Você está recebendo e-mails da lista [email protected]
# Informações sobre os comandos disponíveis (em inglês):
mande e-mail vazio para [email protected]
# Cancelar sua assinatura: mande e-mail vazio para:
[email protected]
# Arquivo de mensagens: http://listarchives.libreoffice.org/pt-br/usuarios/
