Screensaver effect middels VBA code

[snb]

Gebruik dan dit werkblad uitsluitend voor de afbeeldingen die getoond mogen worden: hou het simpul.
Zet de andere afbeeldingen in een ander werkblad.
Dan is je tweede vraag ook opgelost.

Je ziet dat je met heel weinig code toekunt.

 

[pixcel]

Ik heb het gevoel dat de oplossing heel dicht bij ligt, en ik ben aan het proberen wat je schrijft, maar zoals eerder gezegd ik ben niet goed in het begrijpen van VBA code met Option Explicit, Private Sub, Public Sub. ( Ik zou daar echt eens een training in willen krijgen.)

Klik in de code op zo'n sleutelwoord en dan F1 en train jezelf.

Maar ik zie niet hoe ik bij de naam van het plaatje een PREFIX wegzet. ( Ik heb geprobeerd om op de plaatjes met rechts te klikken en hoopte dan iets te vinden om de naam te wijzigen, maar daar zie ik niets wat ik kan gebruiken.)

Op de logische plek gezocht maar excel is niet altijd even logisch. Selecteer een plaatje en wijzig de naam in het Naamvak (links van de formulebalk).

Option Explicit

Private Const PREFIX As String = "SPONSOR-"
Private dTime As Double
Private mlShape As Long

Public Sub StartShow()
    If mlShape = 0 Then
        VerbergSponsors
        mlShape = 1
        Sheet2.Shapes(mlShape).Visible = msoTrue
    End If
    dTime = Now + TimeValue("00:00:04")
    Application.OnTime dTime, "VolgendeSponsor"
End Sub


Public Sub StopShow()
    Application.OnTime dTime, Procedure:="VolgendeSponsor", Schedule:=False
    ToonSponsors
    mlShape = 0
End Sub


Private Sub VolgendeSponsor()
    Dim i As Long
    With Sheet2.Shapes
        .Item(mlShape).Visible = msoFalse
        Do
            mlShape = mlShape + 1
            If mlShape > .Count Then mlShape = 1
            If Left(.Item(mlShape).Name, Len(PREFIX)) = PREFIX Then Exit Do
        Loop
        .Item(mlShape).Visible = msoTrue
    End With
    Call StartShow
End Sub


Private Sub VerbergSponsors()
    Dim i As Long
    For i = 1 To ActiveSheet.Shapes.Count
        With ActiveSheet.Shapes(i)
            If Left(.Name, Len(PREFIX)) = PREFIX Then
                .Left = 50
                .Top = 50
                .Visible = msoFalse
            End If
        End With
    Next i
End Sub


Private Sub ToonSponsors()
    Dim i As Long
    For i = 1 To ActiveSheet.Shapes.Count
        With ActiveSheet.Shapes(i)
            If Left(.Name, Len(PREFIX)) = PREFIX Then
                .Left = 50 + i * 25
                .Top = 50 + i * 25
                .Visible = msoTrue
            End If
        End With
    Next i
End Sub

De twee laatste procedures zijn handig bij het ontwerpen van je sheet. Klik ergens in VerbergSponors en druk op F5. Deze extra functionaliteit kost wel wat extra regels code, dat is een groot nadeel

 

[Humadgen]

Hoi SNB

Ik snap wat je zegt, maar begrijp niet hoe ik het dan moet doen om je code aan te passen dat de plaatjes van sheet2 worden opgepakt en worden getoond in sheet1.

Ik probeer hieronder (voor mezelf ) uit te leggen wat de code doet, maar loop daar ook in vast, dus breek gerust in waar ik fout ga.

IN de code

Public dTime As Double

Public Sub volgende()
    y = 1                                          '= y heeft waarde 1
    For j = 1 To Sheet2.Pictures.Count             '= j is een variable waarde tussen 1 en het aantal plaatjes op sheet2 geteld kan worden.
      If Sheet2.Pictures(j).Visible Then y = j     '= Indien op sheet2 j aantal plaatjes staan, dan wordt de waarde van y gelijk aan j
                                                   '(in plaats van de eerder gedeclareerde waarde 1)
      Sheet2.Pictures(j).Visible = msoFalse        '= en laat je van sheet 2 het plaatje zien. 
    Next                                           'volgende routine = nieuwe plaatje laten zien
        
    Sheet2.Shapes((y + 1) Mod Sheet2.Shapes.Count + 1).Visible = msoTrue  'Dit doet iets met de MOD operator ( maar ik snap MOD niet) 
    dTime = Now + TimeValue("00:00:04")           'dit is de time interval 
    Application.OnTime dTime, "volgende"          'hier wordt na de tijds interval de volgende Public sub gestart na 4 seconden

 End Sub

Als ik bovenstaande goed beschreven heb, dan snap ik niet hoe ik de plaatjes naar sheet 1 laat komen ( als ik er een sheet bij doe )

Bovendien is er dan nog het probleem met het aantal laatjes dat worden getoont als ik er een nieuw plaatje bij zet. Hoe kan dat?

Vriendelijke groeten
Humadgen

 

[snb]

Mijn verhaal is: verwijder de plaatjes die je niet wisselend wil laten zien uit sheet2. Zet ze in een ander werkblad (bijv. sheet3).

0 mod 5 =0
1 mod 5 =1
2 mod 5 =2
3 mod 5 =3
4 mod 5 = 4
5 mod 5 =0
6 mod 5 =1 etc.

als je het 'volgende' plaatje wil laten zien:
de index van het huidige plaatje ( y) +1

omdat er geen plaatje is met index 0, moeten we bij het resultaat van (y+1) mod 5, 1 optellen:
(y+1) mod 5 +1

 

[Humadgen]

@ pixcel

Ik heb nog wel even lopen zoeken want kreeg het maar niet voor elkaar om de (achteraf natuurlijk heel eenvoudige instructie) uit te voeren:

Selecteer een plaatje en wijzig de naam in het Naamvak (links van de formulebalk).

, want ik vergat steeds op <Enter> te drukken.

Maar goed na nog wat aanklooien , googlen , en je instructie over en over lezen...... :thumb:

Ik heb alleen nog een klein stukje aangepast in je code

Public Sub StartShow()
    If mlShape = 0 Then
'        VerbergAlles
        mlShape = 1
        Sheet2.Shapes(mlShape).Visible = msoTrue
    End If
    dTime = Now + TimeValue("00:00:02")
    Application.OnTime dTime, "VolgendeSponsor"
End Sub

door een ' voor VerbergAlles te zetten
om ervoor te zorgen dat de "niet SPONSOR plaatjes" blijven staan, en alleen de SPONSORS om beurten verschijnen..


@ snb

Ik wil jou methode ook nog proberen te doorgronden. Want ik heb in het verleden al vaker oplossingen van je gezien op problemen in het Forum, en die bevielen me meestal wel.

Het idee dat de plaatjes van een ander blad komen spreekt me namelijk nog meer aan omdat ik dan volgens mij nog eenvoudiger de sponsoren kan ( laten ) bijhouden door de jeugdcommissie. ( want dan hoef ik ze niet uit te leggen hoe de naam SPONSOR PREFIX toe te gebruiken ) , want dat zie ik vroeg of laat fout gaan.

Maar met de oplsooing van pixcel ben ik al heel erg blij.

Allebei tot zover enorm bedankt.

Ik zet de vraag alvast op opgelost, mocht ik nog een uitleg nodig hebben bij snb, zet ik hem wel weer tijdelijk open.

Grtnx
Humadgen

 

[snb]

Ik heb hem nog maar iets verbeterd.

 

[pixcel]

door een ' voor VerbergAlles te zetten

Heb je wel de laatste versie gebruikt? In #22 staat geen VerbergAlles maar VerbergSponsors

 

[Humadgen]

Hoi pixcel

Ja snap en zie wat je zegt, ik had op een bepaald moment zoveel excel sheets open, misschien heb ik iets zitten veranderen in een andere versie.

Vriendelijke groeten

Humadgen

 

[pixcel]

Het idee dat de plaatjes van een ander blad komen spreekt me namelijk nog meer aan omdat ik dan volgens mij nog eenvoudiger de sponsoren kan ( laten ) bijhouden door de jeugdcommissie.

Vervang VerbergSponsors door een procedure UpdateSponsors die:
- alle sponsor afbeeldingen uit je sheet2 verwijdert
- alle afbeeldingen uit je sponsorsheet kopieert naar sheet2, ze hernoemt (.name = PREFIX & .name) en tot slot verbergt.
De rest kan dan hetzelfde blijven.

 

[snb]

Je kunt ook als alternatief alle veranderlijke afbeeldingen in een aparte array zetten.
Je hoeft er alleen voor te zorgen dat de niet veranderlijke afbeeldingen een gemeenschappelijk kenmerk in de naamgeving hebben ( in het bijlagevoorbeeld: 'vast_1', 'vast_2', 'vast_3').
De naamgeving van de sponsorafbeeldingen maaakt dan niet uit.

Zie de bijlage.