Macro inc. on error go to start, import image, crop image

[DWatPerry]

This is a Macro that has taken me weeks of research to write, mainly because I have had no experience with Macro before and finding the information on how to write the different codes took alot of research so I am sharing this Macro on here so that anyone struggling with any part of their macro that is similar to mine can at least have a reference to start from, especially seeing as most of the Macro's I found had no real explanation to them and the code often didn't make any sense to someone who didn't know a thing about them!

1. The first part of the macro gets it to pause for 45 seconds before it is run (I have an outside program creating the files my macro needs and it triggers my macro so it has to wait before it starts for the files to be created.)

2. It then looks for a file path in the cell that has been called "JPEG" again this path is written by my outside program. So if the "picpath" = 0 (0 meaning the files isn't there) then got to "Start:" which as you can see sends it back to the start so that it pauses again. This stops the macro from crashing because even if the file isn't there it has a command to follow.

3. when the file has been created it then imports the file (an image) and puts it in the right place.

4. I then crops the image down to the sizes that I have specified (this was a bit of trial and error really) I just changed the numbers after it had been run a few times to suit what I needed.

5. It then looks at a different sheet to import a company logo. I done this last because the crop command crops all the pictures and it was cropping to logo down too which I didn't need it to do.

If this helps just one person it will be worth it! Good luck to any Newbies out there too... I feel for you!

Sub Macro2()
Start:
newhour = Hour(Now())
newminute = Minute(Now())
newsecond = Second(Now()) + 45
waittime = TimeSerial(newhour, newminute, newsecond)

Application.Wait waittime
    
Dim picture As Object
Dim address As String
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer

address = Range("JPEG")
x = Range("X7:Z7").Width
y = Range("X7:X72").Height
picpath = Len(Dir(address))
 

 
 If picpath = 0 Then GoTo Start:
 
 
 Range("AL7").Select
    
       With ActiveSheet.Pictures.Insert(address)

        
   .Left = Range("X7:z78").Left
        .Top = Range("X7:z78").Top
        .Width = Range("X7:z78").Width
        .Height = Range("X7:Z78").Height
    
    
End With
    

Dim shp As Shape
Dim sngMemoLeft As Single
Dim sngMemoTop As Single
Dim i As Integer
i = 0
For Each shp In ActiveSheet.Shapes
With shp
' Insert Shape Type Check (Check in Watches Window)
' If shape is picture, then Type = 13
' If shape is WordArt, then Type = 15
'... etc
' Eg: If Shape is comment (Type = 4)
' it will generate error.
If .Type = 13 Then
sngMemoLeft = .Left
sngMemoTop = .Top

With .PictureFormat
.CropLeft = 100
.CropTop = 20
.CropBottom = 60
.CropRight = 100
End With

.Left = sngMemoLeft
.Top = sngMemoTop




End If
End With
Next

  Sheets("PerryLogo").Select
    ActiveSheet.Shapes("Picture 1").Select
    Selection.Cut
    Sheets("Generator").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("AF6").Select
Sheets("PerryLogo").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("W7").Select
Sheets("Generator").Select
End Sub

 

[Norie]

Just curious, do you have to wait 45 secs for each picture?

 

[DWatPerry]

no, not if the pictures are there. If they are created then they import straight away, if not then wait 45 seconds. But obviously you could change the time to suit whatever you needed with the way this has been written.

 

[Macropod]

Instead of waiting a fixed 45 seconds, you could simply implement a loop that tests for the presence of the files and starts executing immediately they're available. This has two advantages - potentially faster execution if the files are available in less than 45 seconds and whatever extra waiting time might be needed if they're not available - even after 45 seconds (though you might still want a timer to trigger an exit if the files don't become available in a reasonable time).

 

[Norie]

Dwatperry

I was thinking along the same lines as Paul.

Something like this perhaps.

Do
      picpath = Len(Dir(address))
Loop Until picpath>0

 

[DWatPerry]

wow thanks guys! works a treat. Really glad I put it on here now! Thanks again!

 

[Macropod]

Now all you need to do is to get rid of those inefficient, flicker-inducing selections. It seems to me that all of this:

Sheets("PerryLogo").Select
ActiveSheet.Shapes("Picture 1").Select
Selection.Cut
Sheets("Generator").Select
Range("A1").Select
ActiveSheet.Paste
Range("AF6").Select
Sheets("PerryLogo").Select
Range("R1").Select
ActiveSheet.Paste
Range("W7").Select
Sheets("Generator").Select

could probably be reduced to:

Sheets("PerryLogo").Shapes("Picture 1").Cut
Sheets("Generator").Range("A1").Paste
Sheets("PerryLogo").Range("R1").Paste