Fade a splash screen

[Jacko]

Hey guys and hello from the first timer ...

I'm looking for a simple, easy for me to understand code to fade out an intro splash screen I'm using in my spreadsheets.

So far I have been directed to a couple of sites (thanks to those people) and picked up the following but way to complicated for me and one of them was very unstable. (made my spreadsheet invisible)

http://www.vbaexpress.com/kb/getarticle.php?kb_id=166

http://www.xcelfiles.com/SplashScrn.html

Can any one help me ...... Thanks

[Bob Phillips]

Here is a simple example

[Killian]

Hi Jacko and welcome to VBAX
I've combined a couple of known techniques to make an example (attached - only tested in Excel 2003 so far). IMHO the best solution to your requirement will involve using Windows API functions for the timer and form transparency, so not exactly basic but hardly rocket science either. I've thrown a few comments in but please post back if anything isn't clear.

Code derived from:
Using Windows timers by Chip Pearson and
Transparent Userform at Colo's Excel Junk Room

[Bob Phillips]

I've combined a couple of known techniques to make an example (attached - only tested in Excel 2003 so far). IMHO the best solution to your requirement will involve using Windows API functions for the timer and form transparency.

Interesting, you interpreted fading literally, I just interpreted it as a splash screen that would time out.

[Killian]

Yeah, I was quite impressed by Colo's transparency sample but I never had the oppotunity to use it for anything... and then I saw the word "fade" ! I'm not a huge fan of code that doesn't actually add functionality but it's a fun script to play with

[Jacko]

Thanks for your reply ..... really appreciated...

Unfortunately I got the following error message -

Compile error
Syntax error

and the following line highlighted..

TimerID = SetTimer(0&, 0&, TimerSeconds, AddressOf TimerProc)

I'm using XP and MS Office 97, if that may mean anything..

Any clues.....

[Jacko]

Thanks for the reply - yours is similar to the one I'm currently using. The fade adds a new dimension dont you think...

[Jacko]

And there's more,

Tried it on MS Office 2003 and it works great can u set it up for 97...

Love your work..

[Killian]

Glad you like it...
Unfortunately, getting it to work in 97 is going to be a challenge since the AddressOf operator is unsupported.
It's tempting to use Application.OnTime or other easily accessible VBA time related stuff but I'm not sure there's a way of using any of these with fractions of a second (which we need for animating)
I think the best option is write your own equivalent function for AddressOf by using the older VBA Win API functions. This won't run in Office2000+ so if we use the conditional compilation directive we can have one command for 97 and another for 2000+.

So, in your form code:
1. Add the required function declarations

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
    Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias _
    "TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, _
    ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias _
    "TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As String, _
    ByRef lpfn As Long) As Long

2. Add this new function to be used in 97

Private Function AddrOf(strFuncName As String) As Long
'   Returns a function pointer of a VBA public function given its name. This function
'   gives similar functionality to the VBA6 AddressOf param type.
Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
Const NO_ERROR = 0
' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Get the current VBA project
    Call GetCurrentVbaProject(hProject)
' Make sure we got a project handle
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function

3. Change the StartTimer routine to conditionally compile the correct statement for the version of VBA being used[VBA]Sub StartTimer()

TimerSeconds = 250 'timer interval (in milliseconds)
#If VBA6 Then 'compiled in only Excel 2000 and the later version
        TimerID = SetTimer(0&, 0&, TimerSeconds, AddressOf TimerProc)
    #Else 'compiled in Excel 97
        TimerID = SetTimer(0&, 0&, TimerSeconds, AddrOf("TimerProc"))
    #End If
End Sub

That should do it... it seems to work fine for me but I would recommend some extensive testing (both versions) to be sure you trap any errors - particularly unexpected return values from the API functions since they can be somewhat unpredictable.

Enjoy...

[Sir Babydum GBE]

Now that's what I call sexy! Nice code Killian, think I'll use it myself!

[Jacko]

Love your work ..... but way above my head....

Is it possible for you to amend the original code u sent to run under Excel 97...

Many thanks from down under...

[Killian]

Many thanks from down under...

... happy to help. Now if you could just arrange for Glenn McGrath to retire now he's got his 500 (preferably before play resumes) I'd be grateful

Here's a file with the new code added that works with all Office versions.

[Bob Phillips]

Love your work ..... but way above my head....

Is it possible for you to amend the original code u sent to run under Excel 97...

Many thanks from down under...

[johnske]

... Now if you could just arrange for Glenn McGrath to retire now he's got his 500 (preferably before play resumes) I'd be grateful ...

You wish!...

[Bob Phillips]

You wish!...

Don't worry, that natural born Englishman, Kevin Pietersen, and our home grown Geraint Jones will wear him out before the end of the series, and that will retire him (and, yes I do ...).

[Jacko]

Thanks for your help...

The fading is working perfectly on all systems inc. 2003, 2000 and 97..

As mentioned - love your work..