Date: prev next · Thread: first prev next last
2012 Archives by date, by thread · List index


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 <denismod-libo@yahoo.com.br> escreveu:
oi Gilvan,

se puder, posta ai... seria interessante ver esse codigo...


[ ]'s




Denis Dobbin
-------------------



________________________________
 De: Gilvan Vilarim <gilvan.vilarim@gmail.com>
Para: usuarios@pt-br.libreoffice.org
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 usuarios@pt-br.libreoffice.org
# Informações sobre os comandos disponíveis (em inglês):
  mande e-mail vazio para usuarios+help@pt-br.libreoffice.org
# Cancelar sua assinatura: mande e-mail vazio para:
  usuarios+unsubscribe@pt-br.libreoffice.org
# Arquivo de mensagens: http://listarchives.libreoffice.org/pt-br/usuarios/

Context


Privacy Policy | Impressum (Legal Info) | Copyright information: Unless otherwise specified, all text and images on this website are licensed under the Creative Commons Attribution-Share Alike 3.0 License. This does not include the source code of LibreOffice, which is licensed under the Mozilla Public License (MPLv2). "LibreOffice" and "The Document Foundation" are registered trademarks of their corresponding registered owners or are in actual use as trademarks in one or more countries. Their respective logos and icons are also subject to international copyright laws. Use thereof is explained in our trademark policy.