✔ VBA Dashboards Specialist®: VBA Word Tips - Insira Imagens de um diretório no Word - Batch insert pictures with filenames as captions

Imagine que o seu trabalho envolva tirar fotos e apresentá-las num relatório com comentários, que são na verdade os nomes dos respectivos arquivos, dentro de um bem elaborado template do MS Word.

Seria muito bom ter uma ferramenta que pudesse fazer a importação de todas as fotos de um diretório e colocar os seus respectivos nomes de arquivo como comentário abaixo das fotos não seria?

Outra provável situação seria precisar inserir imagens de uma aplicação num manual de uma aplicação.

Você já capturou todas as imagens, colocou os respectivos nomes e agora deseja inserí-las no seu documento, acrescentando os respectivos textos.

Mas ainda há mais uma possibilidade na qual consigo pensar:

Imagine que a sua aplicação MS Excel, conectado ao MS Access, contém uma macro que exporta todos os seus gráficos como imagens para um diretório.

Mas a sua macro não exporta somente gráficos, ela exporta também tabelas, conjuntos de dados, Ranges nomeados e mesmo alguns Mapas que inseriu para ilustrar as áreas que desejava dar foco nas suas análises.

Digamos que agora você precise criar um relatório tal como um Annual Report ou um Financial Report.

Então divirta-se com a solução abaixo.

O código abaixo permite que insira fotos .JPG:

Sub InsertAllPicsWithCaption()
Dim file
Dim path As String

Let path = "C:\Bernardes\Photos\"

Let file = Dir(path & "*.jpg")

CaptionLabels.Add Name:="Filename"

Do While file <> ""

With Selection
.EndKey Unit:=wdStory
.InlineShapes.AddPicture FileName:=path & file, _
LinkToFile:=False, SaveWithDocument:=True
.InsertAfter vbCrLf & vbCrLf
.Collapse 0
.MoveLeft Unit:=wdCharacter, Count:=1
.Style = "Comentário: "
.Text = path & file

End With

Let file = Dir()
Loop
Selection.EndKey Unit:=wdStory
End Sub

Neste código poderá insirir fotos .JPG, .PNG e . TIF:

Sub InsertAllPicsWithCaption2()

Dim file
Dim path As String

Let path = "C:\Bernardes\Photos\"
Let file = Dir(path & "*.jpg")

CaptionLabels.Add Name:="Filename"

Do While file <> ""
' Testando as extensões...

If UCase(Right(file, 3)) = "PNG" Or _
UCase(Right(file,3)) = "TIF" Or _

UCase(Right(file,3)) = "JPG" Then

With Selection
.EndKey Unit:=wdStory

.InlineShapes.AddPicture FileName:=path & file, _
LinkToFile:=False, SaveWithDocument:=True

.InsertAfter vbCrLf & vbCrLf
.Collapse 0

.MoveLeft Unit:=wdCharacter, Count:=1
.Style = "Comentário: "

.Text = path & file
End With

End If

Let file = Dir()

Loop

Selection.EndKey Unit:=wdStory
End Sub