PDA

View Full Version : Picture input via VBA in Excel 2007



Markus22
10-17-2011, 11:59 AM
Dear all,

I have a problem with an already existing VBA Code. The code worked well in Excel 2003 but in Excel 2007 the code does not work as it should. Instead putting the pictures in cell A13 the photos are all included direcly in the beginning and all pictures are overlapping each others.

Can sb help here please?

Thank you ver much.

Best,
Markus


Sub Bilder()
Dim strPicture1 As String
Dim strPicture2 As String
Dim strPicture3 As String
Dim strPicture4 As String
Dim strPicture5 As String
Dim strPicture6 As String
Dim strPicture7 As String
Dim strPicture8 As String
Dim strPicture9 As String
Dim strPicture10 As String
Dim strPicture11 As String
Dim strPicture12 As String
Dim strPathPhoto As String
Dim S1 As Object
Dim S2 As Object
Dim S3 As Object
Dim S4 As Object
Dim S5 As Object
Dim S6 As Object
Dim S7 As Object
Dim S8 As Object
Dim S9 As Object
Dim S10 As Object
Dim S11 As Object
Dim S12 As Object
Dim oAWb As Workbook
Application.ScreenUpdating = False
strPathPhoto = ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A1") & "\"
On Error Resume Next
Sheets("Ertragswertkalkulation").Activate
ActiveWorkbook.Sheets("Ertragswertkalkulation").Activate
strPicture1 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#01.jpg"
strPicture2 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#02.jpg"
strPicture3 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#03.jpg"
strPicture4 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#04.jpg"
strPicture5 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#05.jpg"
strPicture6 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#06.jpg"
strPicture7 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#07.jpg"
strPicture8 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#08.jpg"
strPicture9 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#09.jpg"
strPicture10 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#10.jpg"
strPicture11 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#11.jpg"
strPicture12 = strPathPhoto & ActiveWorkbook.Sheets("Ertragswertkalkulation").Range("A2").Value & "#12.jpg"
ActiveSheet.Shapes("Bild_1").Delete
ActiveSheet.Range("A13").Select
Set S1 = ActiveSheet.Pictures.Insert(strPicture1)
S1.Name = "Bild_1"
S1.Height = 150
S1.Width = 250
ActiveSheet.Shapes("Bild_2").Delete
ActiveSheet.Range("AA396").Select
Set S2 = ActiveSheet.Pictures.Insert(strPicture2)
S2.Name = "Bild_2"
S2.Height = 150
S2.Width = 250
ActiveSheet.Shapes("Bild_3").Delete
ActiveSheet.Range("B413").Select
Set S3 = ActiveSheet.Pictures.Insert(strPicture3)
S3.Name = "Bild_3"
S3.Height = 150
S3.Width = 250
ActiveSheet.Shapes("Bild_4").Delete
ActiveSheet.Range("AA413").Select
Set S4 = ActiveSheet.Pictures.Insert(strPicture4)
S4.Name = "Bild_4"
S4.Height = 150
S4.Width = 250
ActiveSheet.Shapes("Bild_5").Delete
ActiveSheet.Range("B429").Select
Set S5 = ActiveSheet.Pictures.Insert(strPicture5)
S5.Name = "Bild_5"
S5.Height = 150
S5.Width = 250
ActiveSheet.Shapes("Bild_6").Delete
ActiveSheet.Range("AA429").Select
Set S6 = ActiveSheet.Pictures.Insert(strPicture6)
S6.Name = "Bild_6"
S6.Height = 150
S6.Width = 250
ActiveSheet.Shapes("Bild_7").Delete
ActiveSheet.Range("B469").Select
Set S7 = ActiveSheet.Pictures.Insert(strPicture7)
S7.Name = "Bild_7"
S7.Height = 150
S7.Width = 250
ActiveSheet.Shapes("Bild_8").Delete
ActiveSheet.Range("AA469").Select
Set S8 = ActiveSheet.Pictures.Insert(strPicture8)
S8.Name = "Bild_8"
S8.Height = 150
S8.Width = 250
ActiveSheet.Shapes("Bild_9").Delete
ActiveSheet.Range("B486").Select
Set S9 = ActiveSheet.Pictures.Insert(strPicture9)
S9.Name = "Bild_9"
S9.Height = 150
S9.Width = 250
ActiveSheet.Shapes("Bild_10").Delete
ActiveSheet.Range("AA486").Select
Set S10 = ActiveSheet.Pictures.Insert(strPicture10)
S10.Name = "Bild_10"
S10.Height = 150
S10.Width = 250
ActiveSheet.Shapes("Bild_11").Delete
ActiveSheet.Range("B502").Select
Set S11 = ActiveSheet.Pictures.Insert(strPicture11)
S11.Name = "Bild_11"
S11.Height = 150
S11.Width = 250
ActiveSheet.Shapes("Bild_12").Delete
ActiveSheet.Range("AA502").Select
Set S12 = ActiveSheet.Pictures.Insert(strPicture12)
S12.Name = "Bild_12"
S12.Height = 150
S12.Width = 250
oAWb.ActiveSheet.Range("B2").Select
Application.ScreenUpdating = True
End Sub