Beste manier voor het vernieuwen van afbeeldingen (VBA) ?

[dprod]

Beste medeforum gebruikers,

Ik ben bezig met het optimaliseren van een tijdkaarten systeem voor diverse leidinggevenden.
Elke leidinggevenden heeft een 'x' aantal medewerkers onder zich, waarvoor per medewerker een sheet (tijdkaart) wordt toegevoegd.
Alle informatie haal ik uit een database bestand, zoals o.a. welke leidinggevende bij de medewerker hoort, hoeveel contracturen deze heeft en wat het personeelsnr is.
Hierdoor is het bestand multifunctioneel voor alle leidinggevenden.

Nu is het belangrijk dat, als medewerker 'x' geslecteerd wordt de juiste handtekening van de leidinggevende geladen/ingevoegd/zichtbaar wordt.

Daar gaat bij deze dus mijn vraag over: wat is de beste manier om via VBA de afbeelding(en) weer te geven.
Het bestand moet namelijk zo klein mogelijk blijven, en niet per sheet (per medewerker dus) 10 handtekening inladen.


Ik heb de VBA code niet bij de hand, deze heb ik gemaakt op mijn werk maar ik kan daar niet uitgebreid internetten...

Mijn huidige werkwijze (welke dus WEL werkt maar mijn inziens inefficient is):
In de sub Worksheet_change een Case...
Deze Case kijkt naar de: - Range("A8").Value - (leidinggevende) van het betreffende sheet, en als deze is veranderd wordt de huidige handtekening verwijdert, en de nieuwe geladen (Pictures.Insert).
Dit werkt in principe prima, want per sheet is er altijd maar 1 plaatje aanwezig wat het bestand relatief klein houd.
Het nadeel is alleen dat bij elke wijziging van de sheet (zoals dat hoor bij worksheet_change), de VBA Code gaat kijken naar het juiste plaatje, en deze al dan niet verwijdert/toevoegd.
Dit werkt langzamer/opvallender dan ik graag zou willen.

Is het ook mogelijk bij het openen van het bestand (liefst het database bestand), alle handtekeningen 1x te laden en vervolgens te linken naar de juiste plek in de betreffende sheets(tijdkaarten).
Deze hoeven dan alleen .Visible te worden wanneer de naam van de leidinggevende overeen komt!

Ik hoor graag wat de mogelijkheden zijn (misschien een function?).
Alvast bedankt...

Gr,
dprod

 

[HSV]

Misschien met deze regel er tussen.

If Not Intersect(target, jouwcel) is nothing then

Dan wordt de code niet uitgevoerd als je niet die (jouwcel) cel veranderd.

 

[dprod]

Dus zoiets als:

workbook_change:

If Not Intersect(Target, Range("B10")) Is Nothing Then 'als cell B10 veranderd dan...
With Range("B10")
    Select Case .Value
        Case Is = ""
            DeletePictures strChef 'roep deletepictures met strChef als huidige string
            strChef = Range("B10") 'geef strChef string de nieuwe waarde ""
        Case Is <> strChef
            DeletePictures strChef 'roep deletepictures met strChef als huidige string
            strChef = Range("B10") 'geef strChef string de nieuwe waarde van B10
            CreatePictures strChef 'roep createpictures met strChef als huidige string
    End Select
End With
End If

plaatje verwijderen:

Public Sub DeletePictures(strFile As String)

Application.ScreenUpdating = False

    On Error Resume Next ' = GEEN LOG MELDING VOOR NODIG
    ActiveSheet.Shapes(strFile).Delete 'strFile is het de naam van het ingevoegde plaatje

End Sub

plaatje invoegen:

Public Sub CreatePictures(strFile As String) 'strFile is de string die meegegeven is bij het aanroepen

    Dim strCheck As Object

Application.ScreenUpdating = False

If strFile = strVinkje Then
    On Error Resume Next
    Set strCheck = ActiveSheet.Shapes(strVinkje) 'kijken of strVinkje nog niet bestaat...
    If strCheck Is Nothing Then 'zo niet dan...
        On Error Resume Next ' = GEEN LOG MELDING VOOR NODIG
        With ActiveSheet.Pictures.Insert(strServerFileLocation & strPictures & strFile) 'vanaf de server locatie het plaatje invoegen
            .Top = Range("P4").Top + 9
            .Left = Range("P4").Left + 19
            .Width = 36
            .Height = 38
            .Name = strFile
        End With
        On Error Resume Next ' = GEEN LOG MELDING VOOR NODIG
        With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & strLocalFileLocation & strPictures & strFile) 'bij geen toegang tot server vanuit hetzelfde pad plaatje invoegen
            .Top = Range("P4").Top + 9
            .Left = Range("P4").Left + 19
            .Width = 36
            .Height = 38
            .Name = strFile
        End With
    End If
Else 'als het niet om het strVinkje gaat maar om een ander plaatje dan...
    On Error Resume Next ' = GEEN LOG MELDING VOOR NODIG
    With ActiveSheet.Pictures.Insert(strServerFileLocation & strPictures & strFile & ".jpg") 'vanaf de server locatie het plaatje invoegen
        .Top = Range("H4").Top + 1
        .Left = Range("H4").Left + 1
        .Width = 104
        .Height = 56
        .Name = strFile
    End With
    On Error Resume Next ' = GEEN LOG MELDING VOOR NODIG
    With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & strLocalFileLocation & strPictures & strFile & ".jpg") 'bij geen toegang tot server vanuit hetzelfde pad plaatje invoegen
        .Top = Range("H4").Top + 1
        .Left = Range("H4").Left + 1
        .Width = 104
        .Height = 56
        .Name = strFile
    End With
End If

End Sub

Werkt goed zo, vroeg me toch af of het niet makkelijker/anders kon.

Gr,
dprod

 

[dprod]

hmmm... dit werkt niet:

If Not Intersect(Target, Range("B10")) is nothing then

Help zegt:
Deze methode geeft een Range-object als resultaat dat de rechthoekige intersectie van twee of meer bereiken voorstelt.

expressieIntersect(Arg1, Arg2, ...)

expressie Optioneel. Een expressie die een Application-object als resultaat geeft.

Arg1, Arg2, ... Range, vereist. De overlappende bereiken. Er moeten minimaal twee Range-objecten worden opgegeven.

Er moeten dus altijd 2 argumenten worden opgegeven, maar het gaat maar om één Range die veranderd, namelijk B10.

gr,
dprod

 

[HSV]

Dan hierbij even een simpel voorbeeldje dat het wel werkt.

 

[dprod]

@HSV

Bijzonder... jou voorbeeld bestand werkt inderdaad perfect.
Maar als ik deze gebruik in mijn sub dan geeft hij een error.
Misschien omdat ik de sub niet direct in de workbook_change gezet?
Ik heb namelijk gewoon een procedure in me module geschreven die ik aanroep in de workbook_change code.
Overigens gebruik ik in mijn code ook direct na de Intersect een With Range... Select Case .Value (zie eerder gepost voorbeeld).
Is het mogelijk dat deze voor de problemen zorgt?

Gr,
dprod

 

[HSV]

@HSV
Misschien omdat ik de sub niet direct in de workbook_change gezet?
dprod

Dat is het.

 

[dprod]

Aha.... zonde maar het is niet anders.
Dan hou ik het voor alsnog bij mijn huidige code.
Deze werkt prima, ik was alleen benieuwd naar alternatieven.
Bedankt voor de feedback!

Status gaat bij deze naar opgelost...

Gr,
dprod