Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA Excel adding pics to each sheet....

Status
Not open for further replies.

SoundofSpheres

Programmer
Aug 21, 2008
14
US
alright I have an excel file that is macro enabled. I have module code that runs through each sheet and adds a picture in a specified directory that has the same name in a specific cell.
so basically i can fill in all my data for my report and then when I am done, I can hit the addpic macro to add all photos to the report saving me a bunch of time...that's the point right? lol...so I can get the code to work beautifully under sheet activation...and then I can write a loop code to go through all sheets to make sure they all get updated...but this just seems to be such a waste, when I could eliminate the repetitive code and write a functioning module. Well It appears that when I stick this code into the module it doesn't seem to check the specific referenced cell on each page, instead it just goes about and adds the pictures,(all) to every page starting with the first page...well there are 102 sheets, and the first 2 are not needed for pictures. Here is the code::
____________________________________

Sub AddPictures()
Dim w As Worksheet
Dim strFilePath As String

On Error Resume Next

'Trying to start the entire operation on the third sheet "AP1"
'the first 2 sheets are for data recording only...no pictures
'but this macro adds pictures starting at the first sheet, no no matter the below code piece
'any help???
Sheets("AP1").Select

For Each w In Worksheets
'this grabs the picture path and puts it into string
strFilePath = (ActiveWorkbook.Path) & ("\Pictures\") & ([b4]) & (".jpg")

' this is for making sure no cells are selected as a group
Range("H1").Select

'this checks the above string to see if it contains a file...
If FileExists(strFilePath) Then
If Len([b4]) > 0 Then

'the 2 lines below have been removed for testing, it has been added into a module.
'ActiveSheet.Shapes(strFilePath).Select
'Selection.Delete

Set Picture = Sheets(w.Name).Pictures.Insert(ActiveWorkbook.Path & ("\Pictures\" & [b4] & ".jpg"))
Picture.Name = strFilePath
Picture.Top = [a23:e55].Top
Picture.Left = [a23:e18].Left
Picture.Width = 660

'this is suppose to move to the next sheet, and it does,
'without this code...the first picture in the directory gets pasted to all sheets.
Call GoNext
'trying to figure out why I get the same picture on every sheet. This is obsolete with the above code, still dosn't hurt
strFilePath = ""

Else
Exit Sub
End If
Else
Exit Sub

End If

Next


On Error GoTo 0
End Sub

'-------------new function--------------------
Function GoNext()
'This function allows us to proceed to the next sheet
Dim i As Integer
i = ActiveSheet.Index + 1
If i > Sheets.Count Then i = 1
Sheets(i).Select

End Function

'------------new function------------------------
Sub DeletePictures()
Dim w As Worksheet

On Error Resume Next

For Each w In Worksheets
Range("H1").Select
ActiveSheet.Shapes(strFilePath).Select
Selection.Delete
Call GoNext

Next

On Error GoTo 0
End Sub
-
'---------------new fucntion---------------------
Function FileExists(PathName As String) As Boolean
Dim iTemp As Integer

'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)

'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select

'Resume error checking
On Error GoTo 0
End Function

_________end of code_________

thanks guys!
 
the first 2 are not needed for pictures
IF w.index > 2 Then
' your code here
End If

check the specific referenced cell
Prefix all cell(s) references with w.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
which 2? the first 2 blocks of code? or the first 2 lines of the "go next" function?

thanks for your help...im going to go play with the gonext function to test it out, if that was what you were tipping me too...

regards.
 





Hi,

this makes no sense to me...
Code:
For Each w In Worksheets
...
         [b]'without this code...the first picture in the directory gets pasted to all sheets.
         Call GoNext[/b]
...
Next
As PHV suggested, "Prefix all cell(s) references with w." You do not need to SELECT or ACTIVATE a sheet in order to do stuff on that sheet IF you do as suggested.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
well i might be wrong, but my understanding is that Worksheets is a collection, so when I dim w As a worksheet, then I am saying for each worksheet in the collection of worksheets. That was my thinking when I wrote that....

I am a bit confused with the prefixing "all cells"

I have - [b4] as the reference for each sheet. So when the code runs it checks cell b4 and whatever that value is it combines it with the string complex and then when I go to add the picture I use that string to add the picture from the specified directory. I had to add in the "FileExists" function cause it errors out if I am missing a picture for a particular sheet. I then wrote the gonext code to move to the next sheet, for some reason..(error on my part somewhere) without the gonext code it just takes the value of the first sheet of cell b4 and then adds that picture into all the other sheets...

ill upload the file so you might be able to take a better look, and see what I am talking about. I can get accomplish what I want by adding code to each and every sheet, but I just figured there was a better way then duplicating code 100 times.

regards.
 
 http://www.onsitewizards.com/SurveyExcel.zip
ahh, you were refereing to the gonext being inside the "For each" command...well I could not get it to proceed to the next sheet to do the code.

thats why I did up the gonext function and then tried to force it to go to the next page before it started over...I dont know...I ahve played with it for such a long time...that I dont know what to do with it now.

 




Code:
For Each w In Worksheets
   Cells(1,1).value = w.name
   w.Cells(2,2).value = w.name
Next
the second statement will overwrite each sheet name in the activesheet A1.

The third statement will write each sheet name in B2 of each sheet.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
but im not looking to write any values to any cells or write the sheet name to any cell. I am trying to grab a picture from a folder and post it to a sheet Where the value in cell b4 is that of the picture name, if there is no value in b4, then there should not be any picture posted to the sheet.

So all the users of my worksheet have to do is name there field pictures to what ever location name that they refer to. That way when they group them in the folder they can run the macro and insert all the pictures to the appropriate sheet.

Thanks for all your help.

regards.
 




"...but im not looking to write any values to any cells or write the sheet name to any cell."

Of course not. It's an EXAMPLE of what using the worksheet object, or not, does.

Can you make the leap? It relates to your unnecessary GoNext function.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I am using the worksheet module. I don't understand what you mean "make a leap"... I don't think that you are understanding my problem. when I execute the code, it does not go to the NEXT sheet. Here is an example of the problem I am facing in a simple version:
Code:
Sub nextsheet()

Dim w As Worksheet
Sheets("AP1").Select

For Each w In Worksheets
         
MsgBox ([a1])
   
Next
End Sub

can you tell me why this code wont proceed to the next sheet and msg me the cell value of a1??

regards.
 
ok, I played around with your code to try and find what it is that your telling me. so I fixed the above code (simple version) with this change

MsgBox (w.[a1])

so I have to asign the sheet to the object when running the code in the FOR loop???? To me it just dosnt make any sense, It should be a repeatable block of code, and when I tell it to do it in every sheet in the collection...hmm....
 
ok..URIKA! by adding the worksheet command into the string when ref the cell I get accurate picture inserts.

changed:
Code:
 strFilePath = (ActiveWorkbook.Path) & ("\Pictures\") & (w.[b4]) & (".jpg")

so one last question....how do I remove the first 2 sheets from the collection of worksheets. The first 2 sheets in my workbook are reference sheets, so they might have a validating value in the specified cell, but is not a sheet that needs an image. How do prevent the code from running on those sheets?

regards,

and thanks for the pointers.
 
ok, I think I got everything working smooth. I just through in a delete shape routine after the next statement. So after all the pics have been added, it just goes to that ref sheet and removes what ever picture was added. So its not ideal...but its a decent workaround. It gets me to my goal. So now I have a pretty decent module that does all I need it to do, and I don't have to repeat code into every sheet. Thanks Skip for your sage advice...it got me in the right direction.
here is the final piece:
Code:
Sub AddPictures()

Dim w As Worksheet
Dim strFilePath As String
Dim shp As Shape
On Error Resume Next

For Each w In Worksheets
  
      For Each shp In w.Shapes
        shp.Delete
      Next shp
        
        strFilePath = (ActiveWorkbook.Path) & ("\Pictures\") & (w.[b4]) & (".jpg")
         Range("H1").Select
  
      If Len([b4]) > 0 Then
         Set Picture = Sheets(w.Name).Pictures.Insert(strFilePath)
         Picture.Name = w.[b4]
         Picture.Top = [a23:e55].Top
         Picture.Left = [a23:e18].Left
         Picture.Width = 660
         strFilePath = ""
       
        End If
  
Next

Sheets("Survey").Select
For Each shp In Sheets("Survey").Shapes
        shp.Delete
    Next shp
          
On Error GoTo 0
End Sub

notice, I removed all the other crap...wasn't needed to get it done. I didn't need a file check function if I just turn off the error control..and then resume it at the end...works nice. Now it doesn't bug out when there is no picture.

thanks!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top