Aravind_91
09-06-2016, 02:35 AM
Hi i am trying insert pictures to my presentation.
I have a code which inserts a batch of pictures in each slide when i select the pictures.
Now i want to insert another batch of pictures in the same slides of batch 1 but with a offset from the 1st batch of pictures.
The code for the picture insertion is
Sub AddFolieBild()
On Error GoTo EndSubRoutine
Dim fdgTemp As FileDialog
Dim lngIndex As Long
Dim sldTemp As Slide
Dim oS1 As Slide
Dim oPicture As Shape
Set fdgTemp = Application.FileDialog(msoFileDialogFilePicker)
With fdgTemp
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg ; *.png", 1
If .Show = -1 Then
For lngIndex = 1 To .SelectedItems.Count
Set sldTemp = ActivePresentation.Slides.Add(Index:=lngIndex, Layout:=ppLayoutBlank) ' vorher ppLayoutTitleOnly
sldTemp.Shapes.AddPicture FileName:=.SelectedItems.Item(lngIndex), _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=226.768, Top:=42.51, Width:=221.953, Height:=141.732 'Change Position and Scale!!!!!!!!!!
Next
End If
End With
EndSubRoutine:
End Sub
Can someone help me with this
I have a code which inserts a batch of pictures in each slide when i select the pictures.
Now i want to insert another batch of pictures in the same slides of batch 1 but with a offset from the 1st batch of pictures.
The code for the picture insertion is
Sub AddFolieBild()
On Error GoTo EndSubRoutine
Dim fdgTemp As FileDialog
Dim lngIndex As Long
Dim sldTemp As Slide
Dim oS1 As Slide
Dim oPicture As Shape
Set fdgTemp = Application.FileDialog(msoFileDialogFilePicker)
With fdgTemp
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg ; *.png", 1
If .Show = -1 Then
For lngIndex = 1 To .SelectedItems.Count
Set sldTemp = ActivePresentation.Slides.Add(Index:=lngIndex, Layout:=ppLayoutBlank) ' vorher ppLayoutTitleOnly
sldTemp.Shapes.AddPicture FileName:=.SelectedItems.Item(lngIndex), _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=226.768, Top:=42.51, Width:=221.953, Height:=141.732 'Change Position and Scale!!!!!!!!!!
Next
End If
End With
EndSubRoutine:
End Sub
Can someone help me with this