View Single Post
  #8   Spotlight this post!  
Unread 21-11-2008, 12:56
Ed Law's Avatar
Ed Law Ed Law is offline
Registered User
no team (formerly with 2834)
 
Join Date: Apr 2008
Rookie Year: 2009
Location: Foster City, CA, USA
Posts: 752
Ed Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond reputeEd Law has a reputation beyond repute
Re: paper: New Scouting Database from Team 2834

Quote:
Originally Posted by Oris View Post
Very nice database of OPR and CCWM.

Got a few suggestions that might improve your excel file.

In order to make the getpicture sub to work every time a new query is requested, change your getpicture sub to the following functions:

Code:
Function getpicture(teamnum As String) As Boolean
    Dim filen as String
    
    If ActiveSheet.Name = "Query" Then
   
    Else
     GoTo Done
    End If

    Dim AC As Range
    Static P As Shape
    On Error GoTo Done
    Set AC = Application.Caller
    If PicExists(P) Then
    P.Delete
    Else
    'look for a picture already over cell
    For Each P In ActiveSheet.Shapes
    If P.Type = msoLinkedPicture Then
    If P.Left >= AC.Left And P.Left < AC.Left + AC.Width Then
    If P.Top >= AC.Top And P.Top < AC.Top + AC.Height Then
    P.Delete
    Exit For
    End If
    End If
    End If
    Next P
    End If
    filen = CurDir + "\" + Format(teamnum) + ".jpg"
    Set P = ActiveSheet.Shapes.AddPicture(filen, True, True, AC.Left + 2.75, AC.Top + 5, 329.25, 247.5)
    getpicture  = True
    Exit Function
Done:
    getpicture  = False
End Function

Function PicExists(P As Shape) As Boolean
    'Return true if P references an existing shape
    Dim ShapeName As String
    On Error GoTo NoPic
    If P Is Nothing Then GoTo NoPic
    ShapeName = P.Name
    PicExists = True
NoPic:
    PicExists = False
End Function
As for calling the function add the following to "I5":

Code:
=getpicture(B2)
Finally to make the query worksheet more user friendly, I would "unlock" cell B2. You can do this by right clicking on B2, Format Cells..., Click Protection, and uncheck Lock. Then you will want to protect the worksheet by going to Tools>Protection>Protect Sheet.. then add a password if you like and uncheck select locked cells. That way the only selectable cell would be "B2" on the Query worksheet.

Hope that helps and Thanks for the information.
-Oris-
Hi Oris,

Wow, thanks for the code. I spent a little bit of time but couldn't figure out how to do it yet. I will try it out this weekend and repost the database.

Does anybody know why I can not delete the two files that I don't need any more now that I am zipping the file to make it smaller?

Ed
__________________
Please don't call me Mr. Ed, I am not a talking horse.
Reply With Quote