Insertar imagenes en Word.

[Salvador1]

Hola:

La macro inserta las fotos que se encuentren en la ruta establecida (en este caso en la carpeta "Fotos").

En teoría, según su autor, debe insertar las 100 primeras imágenes como así dice el código, pero las inserta todas. Y para este caso, si contiene más de 100 fotos da error. Por tanto, hay que poner un número suficientemente grande para que funcione, pero en tal caso ya no inserta la cantidad de imágenes que especificas (100)

¿Hay alguna solución?

Y dicho sea de paso: cuando se quiere cambiar la ruta, hay que modificar dos líneas ("x=Dir..." y "FileName..."). ¿La de Filename podría coger automáticamente la ruta escrita en "x=dir..."? Lo digo para evitar escribir dos veces lo mismo.

Saludos.

Sub InsertarImagenesCarpeta()


Dim ImgArray([COLOR=#ff0000]100[/COLOR]) As Variant

Dim x As String

Dim fotos As Long

Dim i As Integer


x = Dir([COLOR=#ff0000]"D:\Fotos\*.jpg"[/COLOR])


Do

fotos = fotos + 1

ImgArray(fotos) = x

x = Dir

Loop Until x = ""


Selection.EndKey Unit:=wdStory


For i = 1 To fotos

Selection.InlineShapes.AddPicture _

FileName:=[COLOR=#ff0000]"D:\Fotos\" [/COLOR]& _

ImgArray(i), LinkToFile _

         :=False, SaveWithDocument:=True

With Selection

.InsertAfter vbCr & vbCr & "[Escribe un texto]" _

& vbCr & vbCr

.EndOf Unit:=wdStory

End With


Next i


With Selection


.WholeStory

.ParagraphFormat.Alignment = wdAlignParagraphCenter

.MoveDown Unit:=wdLine, Count:=1

End With


End Sub[/CODE]

[Antoni]

Hola:

Así funciona como quieres:

'________________________________________________________________________

[B]

Sub CargarImágenes()[/B]

   InsertarImagenesCarpeta "D:\Fotos\", 100   [COLOR=#008000] 'Directorio, Número de imágenes a insertar[/COLOR]

[B]End Sub[/B]


'________________________________________________________________________



[B]Sub InsertarImagenesCarpeta([COLOR=#0000cd]Directorio [/COLOR]As Variant, [COLOR=#0000cd]Imágenes [/COLOR]As Integer)[/B]


Application.ScreenUpdating = False

Set fs = CreateObject("Scripting.FileSystemObject") [COLOR=#008000]'Todos los archivos[/COLOR]

Set f = fs.GetFolder(Directorio) [COLOR=#008000]'Directorio[/COLOR]

Set fc = f.Files [COLOR=#008000]'Archivos del directorio[/COLOR]


Selection.EndKey Unit:=wdStory

For Each Archivo In fc[COLOR=#008000] 'Por cada archivo del directorio[/COLOR]

   Selection.InlineShapes.AddPicture FileName:=Directorio & Archivo.Name[COLOR=#008000] 'Insertar Imagen[/COLOR]

   n = n + 1

   If n = Imágenes Then Exit For

   With Selection

      .InsertAfter vbCr & vbCr & "[Escribe un texto]" & vbCr & vbCr

      .EndOf Unit:=wdStory

   End With

Next

Application.ScreenUpdating = True


[B]End Sub

[/B]'________________________________________________________________________

 [/CODE]

Todos los archivos del directorio deben ser archivos de imagen, si no, no funcionará

[Salvador1]

Estupendo, Macro.

Diría que incluso va más rápida que la original.

Muchas gracias.