Obrigado... [ ]'s
Denis Dobbin ------------------- ________________________________ De: Gilvan Vilarim <[email protected]> Para: [email protected] Enviadas: Terça-feira, 24 de Julho de 2012 14:52 Assunto: 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 <[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/ -- 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/
