'How can I implement a loop into my code and handle errors more efficiently
I'm creating a report and have automated the procedure for grabbing images and dropping them in. It is working, but is longer than it needs to be. I'm hoping someone can help me lighten the code by implementing a loop.
I tried several ways, but when it comes to the area to drop the image in, it seems to always default to the initial variable I set.
Sub AutoFillInImages()
'DS# = image file name
'DS#_1 = folder name beneath F:\Merchandising\Style's Numbers\DS#\DS# PIC\
'DS#_2 = sub folder beneath DS#.2 or official DS# folder
Dim Pic As Object
Dim shp As Shape
Dim rng As Range
Set rng = Range("A14")
DS1 = rng & " A.jpg"
DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
DS1_2 = Left(DS1, 8)
On Error GoTo DS2
Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile:=msoFalse, _
SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
With shp
.Top = rng.Offset(-9, 0).Top
.Left = rng.Offset(-2, 0).Left
.LockAspectRatio = msoTrue
.Height = 190
.IncrementTop 5
.IncrementLeft 40
End With
DS2:
Set rng = Range("A27")
DS1 = rng & " A.jpg"
DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
DS1_2 = Left(DS1, 8)
On Error GoTo DS3
Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile:=msoFalse, _
SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
With shp
.Top = rng.Offset(-9, 0).Top
.Left = rng.Offset(-2, 0).Left
.LockAspectRatio = msoTrue
.Height = 190
.IncrementTop 5
.IncrementLeft 40
End With
DS3:
Set rng = Range("A40")
DS1 = rng & " A.jpg"
DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
DS1_2 = Left(DS1, 8)
Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile:=msoFalse, _
SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
With shp
.Top = rng.Offset(-9, 0).Top
.Left = rng.Offset(-2, 0).Left
.LockAspectRatio = msoTrue
.Height = 190
.IncrementTop 5
.IncrementLeft 40
End With
End Sub
This code above works, it's just longer than I know it needs to be.
Solution 1:[1]
Create a sub or function which you can call repetitively with a different parameter (Rng). Avoid the use of GoTo. Use On Error Resume Next instead and then create a bracket with If Err.Number = 0 Then for the next section of code to avoid running it in case of error. Note that a renewed On Error Resume Next resets the Err object.
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | Variatus |
