SoundofSpheres
Programmer
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!
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!