Chief Delphi

Chief Delphi (http://www.chiefdelphi.com/forums/index.php)
-   Extra Discussion (http://www.chiefdelphi.com/forums/forumdisplay.php?f=68)
-   -   paper: New Scouting Database from Team 2834 (http://www.chiefdelphi.com/forums/showthread.php?t=70111)

Ed Law 20-11-2008 23:15

paper: New Scouting Database from Team 2834
 
Thread created automatically to discuss a document in CD-Media.

New Scouting Database from Team 2834 by Ed Law

Ed Law 20-11-2008 23:26

Re: paper: New Scouting Database from Team 2834
 
I try to upload the Scouting Database but it says my file is too big. I will try to reduce the size but I will have to delete some of the data.

Ed Law 20-11-2008 23:43

Re: paper: New Scouting Database from Team 2834
 
I split the database into two Excel file. You can stitch it back together if you want or just use part 1 without part 2.

billbo911 21-11-2008 01:37

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by Ed Law (Post 776614)
I split the database into two Excel file. You can stitch it back together if you want or just use part 1 without part 2.

What size would the entire file be if you zipped it first?

R.C. 21-11-2008 01:39

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by billbo911 (Post 776639)
What size would the entire file be if you zipped it first?

If you email it to me I could upload it for you :yikes:

Ed Law 21-11-2008 07:37

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by billbo911 (Post 776639)
What size would the entire file be if you zipped it first?

Thanks for reminding me of that option. It reduced it down to 1.4 Mb. I uploaded the zip file but now I can not delete the two files that were split into part 1 and part 2.

Clinton Bolinger 21-11-2008 10:52

Re: paper: New Scouting Database from Team 2834
 
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-

Ed Law 21-11-2008 12:56

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by Oris (Post 776694)
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

Clinton Bolinger 21-11-2008 13:48

Re: paper: New Scouting Database from Team 2834
 
Forgot one thing about protecting the worksheet, you will also have to check the "Edit Objects" box (scroll down 2nd from the bottom). This will allow for the "I8" robot picture to update correctly.

Look forward to seeing the new version.
-Oris-

Ed Law 21-11-2008 19:48

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by Oris (Post 776732)
Forgot one thing about protecting the worksheet, you will also have to check the "Edit Objects" box (scroll down 2nd from the bottom). This will allow for the "I8" robot picture to update correctly.

Look forward to seeing the new version.
-Oris-

Hi Oris,

It is working now. Thank you. The picture automatically changes when the user type in a new team number in cell B2. One thing I have to change to get it to work is teamnum as Integer instead of teamnum as String.

The picture is okay if the aspect ratio is 4:3 but it get distorted if it is not. How can I maintain the aspect ratio? I tried to do it but was not successful. Can you take a look at the program and see what I did wrong?

I have decided not to protect the worksheet for now since I am still developing it.

Ed

Clinton Bolinger 24-11-2008 08:43

Re: paper: New Scouting Database from Team 2834
 
After:

Code:

Set P = ActiveSheet.Shapes.AddPicture(filen, True, True, AC.Left + 2.5, AC.Top + 2.5, 329, 250)
Add:

Code:

    P.ScaleHeight 1, True
    P.ScaleWidth 1, True
    P.Height = 250

That should keep the aspect ratio of the pictures.

-Oris-

Ed Law 06-12-2008 19:24

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by Oris (Post 777230)
After:

Code:

Set P = ActiveSheet.Shapes.AddPicture(filen, True, True, AC.Left + 2.5, AC.Top + 2.5, 329, 250)
Add:

Code:

    P.ScaleHeight 1, True
    P.ScaleWidth 1, True
    P.Height = 250

That should keep the aspect ratio of the pictures.

-Oris-

Hi Oris,

I tried it and it worked. However when I tried it on Excel 2007, I think it changes it back to its original size and then stretch it to Height = 250 without maintaining the aspect ratio. I tried a few things but none seems to work. Can anybody help? I would like to make this work for everybody as more and more people will be using Excel 2007. Thanks.

Ed

Clinton Bolinger 08-12-2008 08:20

Re: paper: New Scouting Database from Team 2834
 
Quote:

Originally Posted by Ed Law (Post 780261)
Hi Oris,

I tried it and it worked. However when I tried it on Excel 2007, I think it changes it back to its original size and then stretch it to Height = 250 without maintaining the aspect ratio. I tried a few things but none seems to work. Can anybody help? I would like to make this work for everybody as more and more people will be using Excel 2007. Thanks.

Ed

Try replacing:

Code:

P.ScaleHeight 1, True
P.ScaleWidth 1, True
P.Height = 250

with:

Code:

P.LockAspectRatio = msoTrue
P.Height = 250

I don't have Excel 2007 on my current computer, so I didn't get a chance to test it.

-Oris-

Ed Law 09-12-2008 23:07

Re: paper: New Scouting Database from Team 2834
 
This spreadsheet is working in Excel 2007 now. The change that Oris suggested works. It is now version 4. I still can not delete the old versions.

I will be posting the 2009 Scouting Database during X'mas break so we can see easily which teams are going to which regionals.

Ed

Clinton Bolinger 10-12-2008 08:35

Re: paper: New Scouting Database from Team 2834
 
I got another one for you Ed to fix your opening issues.

Replace:

Code:

filen = CurDir + "\" + Format(teamnum) + ".jpg"
With:

Code:

Dim sCurDir As String
sCurDir = Mid(ThisWorkbook.FullName, 1, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name))
filen = sCurDir + "\" + Format(teamnum) + ".jpg"

That way the team pictures will load if you open the file by double clicking, open recent, or file open.

Hope this helps,
-Oris-


All times are GMT -5. The time now is 11:00.

Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Copyright © Chief Delphi