Fotobewerking

[Koelieman]

Hoi forumleden,
Het lijkt mij leuk om een verzameling foto's in een Excelbestand te hebben, die normaliter zwart/wit op de sheet staan.
Echter . . als je met de muis op de plaat gaat staan, wordt ie dan in kleur getoond.
Een voorbeeld kun je zien op de website van www.newspower.nl
Hopelijk voor jullie een koud kunstje.

Alvast dank en een groet, koelie.

 

[OctaFish]

Excel kent geen Hover functie, dus met MouseOver kun je niks. Wel met een Click op een plaatje. Probeer maar met deze macro.

Sub Toggle()
Dim oshp As Shape
    Set oshp = ActiveWorkbook.Worksheets(1).Shapes(1)
    With oshp.PictureFormat
        Select Case .ColorType
        Case Is = msoPictureGrayscale
            .ColorType = msoPictureAutomatic
        Case Is = msoPictureAutomatic
            .ColorType = msoPictureGrayscale
        End Select
    End With
End Sub

 

[Koelieman]

Hoi Octafish,

Bedankt voor je reactie. Het is niet hetzelfde wat ik in gedachten had, maar hij is ook leuk.
Groetjes, koelie.

 

[alphamax]

Met "Rollover"-effect

In de cellen onder en rondom de images

=ALS.FOUT(HYPERLINK(hover(RIJ();KOLOM());"");"")

In Thisworkbook

[SIZE=1]Option Explicit

Private Sub Workbook_Open()
    Dim objShape As Object
    With Worksheets("Blad1")
        For Each objShape In .Shapes
            objShape.PictureFormat.ColorType = msoPictureGrayscale
        Next
    End With
    Set objShapeCurrent = Nothing
End Sub
[/SIZE]

In Module1

[SIZE=1]Option Explicit

Public objShapeCurrent As Object

Public Function Hover(lngRow As Long, lngColumn As Long)
    Dim objShape As Object
    On Error Resume Next
    With Worksheets("Blad1")
        For Each objShape In .Shapes
            If objShape.TopLeftCell.Address = .Cells(lngRow, lngColumn).Address And objShape.BottomRightCell.Address = .Cells(lngRow, lngColumn).Address Then    'am_2015
                objShapeCurrent.PictureFormat.ColorType = msoPictureGrayscale
                objShape.PictureFormat.ColorType = msoPictureAutomatic
                Set objShapeCurrent = objShape
                Exit Function
            End If
            objShapeCurrent.PictureFormat.ColorType = msoPictureGrayscale
            Set objShapeCurrent = Nothing
        Next
    End With
End Functio[/SIZE]

 

[Koelieman]

Hoi alphamax,
Dat is het; dat bedoelde ik.
Ik ben vrij lang bezig geweest met het gegeven voorbeeld, maar heb het uiteindelijk toch kunnen namaken.
Bedankt voor de moeite en de aandacht.
Grtz, koelie.

 

[alphamax]

Wanneer je bepaalde eigenschappen van excel op een oneigenlijke manier gebruikt (rollover effect) dan kan het inderdaad langer duren voordat duidelijk is hoe het werkt.