✔ VBA Dashboards Specialist®: DONUT PROJECT - VBA - Exportação Automatizada - De *.docx Para *.pdf

22 de março de 2014

DONUT PROJECT - VBA - Exportação Automatizada - De .docx Para .pdf - Otimizando o tamanho

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Baixe o Calendário Compacto para 2014 em Excel

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 = False

Setup
SelectFilesToConvert

UpdateConverted

Columns.AutoFit
Let Application.ScreenUpdating = True

End Sub

Private Sub Setup()

Cells.Clear

Let 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 = xlNone

Let Range("B:B", "E:E").NumberFormat = "0.0"

With Range("A1:E1")
Let .Interior.Color = RGB(102, 153, 255)

Let .Borders.LineStyle = xlContinuous
End With
End Sub

Private Sub SelectFilesToConvert()
Dim i As Long
Dim r As Range

Set r = Range("A2")

With Application.FileDialog(msoFileDialogOpen)
Let .AllowMultiSelect = True
Let .InitialFileName = "initial path"
Let .InitialView = msoFileDialogViewList
.Filters.Clear
.Filters.Add "Word Documents", "*.docx"

.Show
' Create hyperlinks to the files and show their size in KB

For i = 1 To .SelectedItems.Count

r.Worksheet.Hyperlinks.Add Anchor:=r, Address:=.SelectedItems(i), TextToDisplay:=.SelectedItems(i)
r.Offset(0, 1) = FileLen(r) / 1000

' Open each Word file
OpenWordFile CStr(r)
Set r = r.Offset(1, 0)

Next i
End With
End Sub

Private Sub OpenWordFile(filePath As String)

On Error GoTo ErrCleanUp

Dim wordApp As Word.Application
Set wordApp = New Word.Application

Let wordApp.DisplayAlerts = wdAlertsNone
Let wordApp.Visible = False

Dim wordDoc As Document

Set wordDoc = wordApp.Documents.Open(filePath)

SaveAsMinimizedPDF wordDoc
Let wordDoc.Saved = True
wordDoc.Close
wordApp.Quit

Exit Sub

ErrCleanUp:
Let wordDoc.Saved = True
wordDoc.Close
wordApp.Quit

End Sub

Private 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:=False
End Sub

Private Sub UpdateConverted()
Dim i As Long

Dim r As Range

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set 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
' validate
r.Offset(0, 4).Font.Color = IIf(r.Offset(0, 4) > 100, RGB(255, 0, 0), RGB(0, 255, 0))

Next i
End Sub