Este código, desenvolvido no MS Excel, pode reduzir o tamanho de um documento do Word, por exemplo de 400kb para 100kb.
Suponhamos que lhe pedissem alguma forma de reduzir o tamanho de um arquivo *.docx, que inclui algumas fotos. Uma pergunta mais específica seria a de se há algum modo de realmente reduzirmos o tamanho de um documento do MS Word que tenha incorporado imagens *.Jpg? Essa exigência existe devido a necessidade de enviarmos um e-mail com este documento em anexo, pesando menos do que 100 KB. Digamos que a empresa onde trabalha não permita nada acima de 100 KB e por isso tenhamos que descobrir uma maneira de reduzir o tamanho do arquivo. Não há nenhum formato de arquivo especificado ou exigido.
Certamente após refletirmos um pouco, algumas soluções possíveis vieram:
A compactação de arquivos *.Jpeg, salvando-o num formato de arquivo diferente e reinserindo-os no texto.Capturar um screenshot do documento do MS Word com zoom-out e salvá-lo como um novo arquivo *.Jpg.
Bem, até o momento a melhor solução era realmente fazer screenshots e depois manipulá-los para reduzir o seu tamanho. O único problema era que esse processo seria manual e muito longo, havendo um monte de arquivos para passar.
Após alguns testes com diferentes formatos de arquivo, verificando os resultados (tamanhos). Deparei-me com o recurso de exportação de documento ativo para *.Pdf, mas com a opção de otimização para definir um tamanho mínimo.
Após experimentar isso em cerca de 10 arquivos diferentes, e obter em cada vez, um arquivo menor do que 100 KB de arquivo. Imaginei que seria muito simples abrir um arquivo *.Docx e exportá-lo para um arquivo *.Pdf. Mas ainda imaginava como automatizaria esse processo. Não sabia a quantidade exata de arquivos que precisavam ser convertidos - apenas tinha a impressão de haver muitos deles.
Então, tive a ideia para o processo de automação, criar uma planilha do MS Excel com algumas macros que:
- Solicitasse ao usuário para entrar um ou vários arquivos de uma só vez.
- Abrir cada arquivo.
- Processar cada arquivo (exportação).
- Terminar, formatando as células, colocando os resultados em destaque.
Códigos:
Sub Main()
Let Application.ScreenUpdating = FalseSetupSelectFilesToConvertUpdateConvertedColumns.AutoFitLet Application.ScreenUpdating = True
End SubPrivate Sub Setup()Cells.ClearLet Range("A1") = "Path"
Let Range("B1") = "Size (KB)"
Let Range("D1") = "PDF Path"
Let Range("E1") = "PDF Size (KB)"
Let Range("E:E").Font.Color = xlNoneLet Range("B:B", "E:E").NumberFormat = "0.0"With Range("A1:E1")Let .Interior.Color = RGB(102, 153, 255)Let .Borders.LineStyle = xlContinuousEnd WithEnd SubPrivate Sub SelectFilesToConvert()Dim i As LongDim r As RangeSet r = Range("A2")With Application.FileDialog(msoFileDialogOpen)Let .AllowMultiSelect = TrueLet .InitialFileName = "initial path"
Let .InitialView = msoFileDialogViewList.Filters.Clear.Filters.Add "Word Documents", "*.docx".Show' Create hyperlinks to the files and show their size in KBFor i = 1 To .SelectedItems.Countr.Worksheet.Hyperlinks.Add Anchor:=r, Address:=.SelectedItems(i), TextToDisplay:=.SelectedItems(i)r.Offset(0, 1) = FileLen(r) / 1000' Open each Word fileOpenWordFile CStr(r)Set r = r.Offset(1, 0)Next iEnd WithEnd SubPrivate Sub OpenWordFile(filePath As String)On Error GoTo ErrCleanUpDim wordApp As Word.ApplicationSet wordApp = New Word.ApplicationLet wordApp.DisplayAlerts = wdAlertsNoneLet wordApp.Visible = FalseDim wordDoc As DocumentSet wordDoc = wordApp.Documents.Open(filePath)SaveAsMinimizedPDF wordDocLet wordDoc.Saved = TruewordDoc.ClosewordApp.QuitExit SubErrCleanUp:Let wordDoc.Saved = TruewordDoc.ClosewordApp.QuitEnd SubPrivate Sub SaveAsMinimizedPDF(ByRef doc As Document)doc.ExportAsFixedFormat OutputFileName:= _Split(doc.FullName, ".")(0) & ".pdf", ExportFormat:=wdExportFormatPDF _, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForOnScreen, Range _:=wdExportAllDocument, From:=1, to:=1, Item:=wdExportDocumentContent, _IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _wdExportCreateNoBookmarks, DocStructureTags:=False, BitmapMissingFonts:= _False, UseISO19005_1:=FalseEnd SubPrivate Sub UpdateConverted()Dim i As LongDim r As RangeFor i = 2 To Range("A" & Rows.Count).End(xlUp).RowSet r = Range("A" & i)r.Offset(0, 3).Worksheet.Hyperlinks.Add _Anchor:=r.Offset(0, 3), Address:=Split(r, ".")(0) & ".pdf", _TextToDisplay:=Split(r, ".")(0) & ".pdf"r.Offset(0, 4) = FileLen(r.Offset(0, 3)) / 1000' validater.Offset(0, 4).Font.Color = IIf(r.Offset(0, 4) > 100, RGB(255, 0, 0), RGB(0, 255, 0))Next iEnd Sub
Conheça também:
Série Piece of Cake
- PIECE OF CAKE - MS Excel - Zipando - Compacte no formato Zip
- PIECE OF CAKE - MS Excel - Zipando - Escolha os Arquivos a Compactar
- PIECE OF CAKE - MS Excel - Zipando - Escolha uma Pasta e Compacte
- PIECE OF CAKE - MS Excel - Zipando - Compacte Todos os Arquivos da Pasta
- PIECE OF CAKE - MS Excel - Zipando - Compacte a Planilha Atual
- PIECE OF CAKE - MS Excel - Zipando - Compacte e Envie por e-Mail
- PIECE OF CAKE - Connecting to Oracle 12g with Excel VBA
- PIECE OF CAKE - Extract Path From String
- PIECE OF CAKE - Detecta se Arquivo Existe
- PIECE OF CAKE - MS Excel - Finding Last Row
- PIECE OF CAKE - Obtendo Endereço IP
- PIECE OF CAKE - Criando Arquivo Texto Externo
- PIECE OF CAKE - Criando Tabelas no SQL Server a partir do MS Excel
- PIECE OF CAKE - Notação Húngara
- PIECE OF CAKE - Usando Stored Procedures
- PIECE OF CAKE - Microsoft Access - Removendo Prefixo das Tabelas
- PIECE OF CAKE - MS Access e MS Word - Técnica de Automação
- PIECE OF CAKE - MS Access - 5 Formas Manuais de Reparo
- PIECE OF CAKE - Correção de Métricas
- PIECE OF CAKE - Convertendo Texto em Imagem
- PIECE OF CAKE - Excel - Manipule o Google Maps em sua Planilha
- PIECE OF CAKE - VBA Excel - Traduzindo Planilhas - Google Translate API
- PIECE OF CAKE - Defina a Latitude e a Longitude
Séries Donut
- DONUT PROJECT 2018 - VBA - 12 - Aumente sua Produtividade
- DONUT PROJECT 2018 - VBA - 11 - Os Benefícios do Controle de Versão
- DONUT PROJECT 2018 - VBA - 10 - Loop For-Each
- DONUT PROJECT 2018 - VBA - 09 - Método Count
- DONUT PROJECT 2018 - VBA - 08 - Referenciando Ranges
- DONUT PROJECT 2018 - VBA - 07 - Amostra de Macro
- DONUT PROJECT 2018 - VBA - 06 - Recursos Adicionais
- DONUT PROJECT 2018 - VBA - 05 - Gravando a Primeira Macro
- DONUT PROJECT 2018 - VBA - 04 - Opções de Solução
- DONUT PROJECT 2018 - VBA - 03 - Requisitos e Preparação
- DONUT PROJECT 2018 - VBA - 02 - Continua Cético
- DONUT PROJECT 2018 - VBA - 01 - Maximizando Sua Eficiência
- DONUT PROJECT 2018 - Excel - Gravando Macro Altere SELECT por RANGE
- DONUT PROJECT 2018 - O que Desenvolvedores Aprendem com Michael Jordan
- DONUT PROJECT 2018 - Excel - Macros - Mudando o Mindset
- DONUT PROJECT 2018 - Excel - Acelerando Macros
- DONUT PROJECT 2015 - Extraindo e-Mails
- DONUT PROJECT 2015 - Função - Extraindo Elementos da String
- DONUT PROJECT 2015 - Função - Retornando Nº de ocorrências de um Caractere
- DONUT PROJECT 2015 - Função - Retorna Conteúdo Delimitado por 2 Caracteres
- DONUT PROJECT 2015 - Função - Retorna Apenas o Conteúdo Entre Parênteses
- DONUT PROJECT 2015 - Função - Extrai Conteúdo entre Parênteses
- DONUT PROJECT 2015 - Excel - Report Layout
- DONUT PROJECT 2015 - Excel - Grand Totals - Inserindo Totais na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Mudando a Fonte de Dados da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Aplicando Refresh em Tabelas Dinâmicas
- DONUT PROJECT 2015 - Como Manter Informações parcialmente Anônimas
- DONUT PROJECT 2015 - Excel - Limpando o Filtro da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Criando Filtros Múltiplos na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Criando Filtro de Relatório na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Remover Campos Calculados da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Remover Campos da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Adicionar Campos Calculados na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Apagar todas as Tabelas Dinâmicas
- DONUT PROJECT 2015 - Excel - Apagar Tabela Dinâmica Específica
- DONUT PROJECT 2015 - Adicionar Rodapé de Confidencialidade no Office
- DONUT PROJECT 2015 - Excel - Criando uma Tabela Dinâmica
- DONUT PROJECT - Use os add-ins do MS Excel e dê um salto em sua performance
- DONUT PROJECT - VBA - Automatize o Outlook para enviar um e-mail com anexo
- DONUT PROJECT - VBA - Outlook - Salvando arquivos anexados nos e-mails
- DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT - Moving Annual Total
- DONUT PROJECT - VBA - Excel - Atualize Tabelas Dinâmicas
- DONUT PROJECT - VBA - Excel - Removendo os Caracteres Alfabéticos e Especiais
- DONUT PROJECT 2014 - VBA - Access - Criando uma Query com Parâmetros
- DONUT PROJECT 2014 - VBA - Access - Atualizando o conteúdo de uma Query
- DONUT PROJECT - VBA - Access - Saiba o Número de Registro de cada tabela
- DONUT PROJECT - VBA - Access - Extraia Dados sem Problemas de TIMEOUT
- DONUT PROJECT - VBA - Access - Lista o Tamanho de Todas as Tabelas
- DONUT PROJECT - VBA - Excel - Populando um ListBox no seu Formulário
- DONUT PROJECT - VBA - Excel - Importando arquivos CSV
- DONUT PROJECT - VBA - Excel - Deletando Conexões de Dados
- DONUT PROJECT - VBA - Excel - Obtendo o Nome da Planilha sem a Extensão
- DONUT PROJECT - VBA - WORD - Exportação Automatizada - DOC para PDF
Nenhum comentário:
Postar um comentário