Checkbox and shapes..

[SoundofSpheres]

Well I am onto part 2 of my project, and am trying to get some more code to work. here is what I am doing: I want to have a checkbox representing each subsequent sheet all on one sheet. The checkbox value will be 1 if pictures exist on subsequent sheets, and 0 if no image exists. Also, I keep delete shapes with my AddPicture code.

here is the module code:::

Sub AddPictures()

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

Application.ScreenUpdating = False
Sheets("AP1").Select
For Each w In Worksheets
  Application.StatusBar = " Adding Picture to " & w.Name & "..."
      'For Each shp In w.Shapes
       ' If shp.Name = w.[b4] Then shp.Delete
      'Next shp
        Call RemoveExtraPics
        
        strFilePath = (ActiveWorkbook.Path) & ("\Pictures\") & (w.[b4]) & (".jpg")
         Range("H1").Select
  
      If Len([b4]) > 0 Then
         Set Picture = Sheets(w.Name).Pictures.Insert(strFilePath)
         w.Shapes.Line.Weight = 2
         Picture.Name = w.[b4]
         Picture.Top = Picture.TopLeftCell.Top
         Picture.Top = [a23:F55].Top
         Picture.Left = Picture.TopLeftCell.Left
         Picture.Left = [a23].Left
         Picture.Width = 658
         strFilePath = ""
         
      End If
  
Next

Application.StatusBar = ("Removing unnecessary artifacts...")
 
Sheets("Survey").Select
   Call RemoveExtraPics
   Call ValidateImg
   
On Error GoTo 0
End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++ 
Function RemoveExtraPics()
Dim n As Long, shCount As Long
Dim w As Worksheet

shCount = ActiveSheet.Shapes.Count
If Not shCount > 1 Then Exit Function

For n = 1 To shCount - 1

With ActiveSheet.Shapes(n)
If InStr(.Name, ActiveSheet.[b4]) > 0 Then
.Delete
End If
End With
Next
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++
 
Public Function ValidateImg()

    Application.StatusBar = ("validating Pictures in each sheet...")
For Each w In Worksheets
    Application.ScreenUpdating = True
    w.Activate
Next
    Sheets("AP1").Select
    Application.StatusBar = (" Done")

End Function
'++++++++++++++++++++++++++++++++++++++++++++++++ 

Sub DeletePictures()
Dim w As Worksheet
Dim shp As Shape

On Error Resume Next

For Each w In Worksheets
        For Each shp In w.Shapes
         If shp.Name = w.[b4] Then shp.Delete
    Next shp
    Next w
   On Error GoTo 0

Call ValidateImg

End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++ 

Public Function CheckShape(isShp As String) As Boolean

 On Error Resume Next
    tmpID = ActiveSheet.Shapes(isShp).ID
    If IsEmpty(tmpID) Then
            isShp = False
        'MsgBox "picture does not exists! "
            Else
            isShp = True
        'MsgBox "picture does exist"
         
    End If
    On Error GoTo 0
    
End Function

and here is the activeworksheet code that I am working on now and having problems with::::

Private Sub Worksheet_Change(ByVal Target As Range)

Dim chk As CheckBox
Dim w As Worksheet
Dim shp As Shape

'I am trying to cycle through all of the check boxes on the 'sheet and determine if it needs a check or not. removed 'for testing. 

'For Each shp In Sheets("Survey").Shapes

 For Each w In Worksheets
    If CheckShape(w.[b4]) = False Then
        MsgBox (w.[b4] & " False")
        Sheets("Survey").[Check Box 7].Value = 0
 
    Else
        ActiveSheet.[Check Box 6].Value = 1
        MsgBox (w.[b4] & " True")
    End If
 
'Next

Next
 
End Sub

thanks for all your help guys. and thanks to skip, I know hes gunna enlighten me on my errors in this...

regards,
Corey

 

[SkipVought]

Hi,

Why 2 .Top assignments?

      If Len([b4]) > 0 Then
         Set Picture = Sheets(w.Name).Pictures.Insert(strFilePath)
         w.Shapes.Line.Weight = 2
         Picture.Name = w.[b4][b]
         Picture.Top = Picture.TopLeftCell.Top
         Picture.Top = [a23:F55].Top[/b]
         Picture.Left = Picture.TopLeftCell.Left
         Picture.Left = [a23].Left
         Picture.Width = 658
         strFilePath = ""
         
      End If

Why not simply

[s]
         Picture.Top = Picture.TopLeftCell.Top[/s]
         Picture.Top = [a23].Top

"I want to have a checkbox representing each subsequent sheet all on one sheet. "

Take a look at the Shapes collection in the Worksheet object

dim ws as worksheet, sp as object as object, spCB as object
for each ws in worksheets
  set spCB = SumSheetObject.CheckBoxes.Add(1, 1, 1, 1)
  for each sp in ws.shapes
    if shp.name like "*pic*" then 'or whatever identifies your pics in common
       spCB.oleformat.object.value = 1
    end if
  next
next

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SoundofSpheres]

skip, your just a father on this stuff for me. I pray that you will be here in the future with more of my stumbling code... I appreciate your tips. Yes, the double lines on the top and left code was a mistake. It, however didn't produce any errors, so I just overlooked it. It was suppose to be commented out, ultimately removed for publication purposes, but I dint catch it.

That example usage of the the shapes looks like it will work good. I am going to test it out tonight, and see what results I can reach.

Thanks for your quick replies.

Regards,
Corey

 

[SkipVought]

This might work better...

Dim ws As Worksheet, sp As Object, spCB As Object, i As Integer

For Each ws In Worksheets
  Set spCB = ActiveSheet.CheckBoxes.Add(1, 1, 1, 1)
  With spCB
    .Top = 15 * i
    .Height = 10
    .Width = 60
    .Left = 0
    .Caption = ws.Name
  End With
  For Each sp In ws.Shapes
    If UCase(sp.Name) Like "*PIC*" Then 'or whatever identifies your pics in common
       spCB.Value = 1
    End If
  Next
  i = i + 1
Next

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SoundofSpheres]

well, I played with the shapes collection last night and did not have any results, actually it didn't do anything...so I made some changes, and still nothing would fire. So I removed the error handler to see what was going on...

Set spCB = SumSheetObject.CheckBoxes.Add(1, 1, 1, 1)

Object Required...so I went back and checked on my checkboxes to see what values they had...then I could not access the properties pane...so should I be using activeX components, or is this userform stuff acceptable? The only identifying thing for these checkboxes are the object names...ie: "Check Box 134" On the reference to the image shape that is placed on the other sheets...I changed "*pic*" to [b4]. and I may have to add in the sheet as well, but I haven't gotten to that part yet...But all the images on every sheet is going to be named with whatever b4 is.

thanks

 

[SoundofSpheres]

I modified the code as per below...I still can't get it to check for the images on the sheets. I was planning to add this into the Survey sheets "change" Section, so that the check boxes will be up to date as much as possible. So I guess maybe I should try to approach from a different perspective. possibly adding some code into the add picture routine, and check a box on the "Survey" sheet if a pic is inserted.
I already have the check boxes on the sheet, is there a way to reference them as a collection, as they already exist. It does seem less tedious just adding the the box and ticking it if a pic is inserted. But I still can't get it to check the pic is there or not, and if the code is ran again, I get a duplication of the boxes.


thanks corey

 

[SkipVought]

The last code I posted, checked out and CHECKED the box when there was a pic on the sheet.

BTW, my pics all begin with "Pic"

"...But I still can't get it to check the pic is there or not..."

    If UCase(sp.Name) Like "*PIC*" Then 'or whatever identifies your pics in common
       spCB.Value = 1
    End If

"...if the code is ran again, I get a duplication of the boxes."

Then separate ADDING the checkboxes from CHECKING the checoboxes. Or DELETE all the checkboxes before running this procedure, via code, of course.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SoundofSpheres]

hmm...ok let me give it a valiant effort. I will report back with any other oddities I create...lol