Re: [pt-br-usuarios] RESOLVIDO: Gerar miniaturas de apresentacao

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/