code aanpassen

[SUVERMO]

Dag allemaal

op de eerste lijn van de code van Blad1 staat
Const PictDir As String = "C:\Users\Vermonden\Pictures\DIEREN"

"C:\Users\Vermonden\Pictures\DIEREN" staat in de cel FOTO_MAP = cel D4

Kan iemand de de code aanpassen zodanig dat steeds de inhoud gebruikt wordt van cel FOTO_MAP = cel D4

 

[edmoor]

Als je een variabele op runtime wilt aanpassen mag het uiteraard geen Const zijn.

Dim PictDir As String
PictDir = Range("D4").Value

 

[SUVERMO]

Goede morgen Ed,

ik krijg nu een foutmelding

 

[AD1957]

Verander dit

PictDir = Range("FOTO MAP").Value

eens in

PictDir = Range("FOTO[COLOR="#FF0000"]_[/COLOR]MAP").Value

 

[SUVERMO]

hierbij de code die bij mij deze foutmelding geeft

'Const PictDir As String = "C:\Users\Vermonden\Pictures\DIEREN\"
PictDir = Range("FOTO_MAP").Value




Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub

Private Sub Worksheet_Activate()

    Image1.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    Image2.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    Image3.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" Then
    If Not Dir(PictDir & Target & ".jpg") = vbNullString Then
        With Image1
            .Picture = LoadPicture(PictDir & Target & ".jpg")
            .PictureSizeMode = 3
        With .ShapeRange
              .Height = 123.9307
              .Width = 205
            End With
        End With
    Else
        Image1.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    End If

    If Not Dir(PictDir & Range("F9").Value & ".jpg") = vbNullString Then
        With Image2
            .Picture = LoadPicture(PictDir & Range("F9").Value & ".jpg")
            .PictureSizeMode = 3
        With .ShapeRange
              .Height = 90.681
              .Width = 150
            End With
        End With
    Else
        Image2.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    End If

    If Not Dir(PictDir & Range("F25").Value & ".jpg") = vbNullString Then
        With Image3
            .Picture = LoadPicture(PictDir & Range("F25").Value & ".jpg")
            .PictureSizeMode = 3
        With .ShapeRange
              .Height = 90
              .Width = 150
            End With
        End With
    Else
        Image3.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    End If
End If



Application.ScreenUpdating = False
  KolommenZichtbaar
  If Range("GENERATIES").Value = 2 Then Columns("I:N").Hidden = True
  If Range("GENERATIES").Value = 3 Then Columns("K:N").Hidden = True
  If Range("GENERATIES").Value = 4 Then Columns("M:N").Hidden = True
Application.ScreenUpdating = True
End Sub
Sub KolommenZichtbaar()
  Columns.Hidden = False
End Sub

 

[edmoor]

Dat mag niet buiten je Sub. Doe dat zo:

Dim PictDir As String

Sub NaamVanJeSub()
    PictDir = Range("FOTO_MAP").Value
End Sub

 

[SUVERMO]

Dag Ed,

ik heb verschillende mogelijkheden geprobeerd maar het lukt mij niet, tekens een foutmelding
waar moet uw code ergens komen
kan jij dit doen?

 

[edmoor]

Dat lijkt me toch echt duidelijk in het voorbeeld dat ik liet zien.
De Dim opdracht bovenin de betreffende module en het geven van een waarde aan die variabele in de betreffende Sub.
Als die variabele alleen in de betreffende Sub wordt gebruikt kan het gewoon allebei in die Sub.

Daarnaast, als je zegt een foutmelding te krijgen, vertel er dan ook bij welke dat is.

 

[snb]

Staat ook hier:

https://www.dummies.nl/producten/9789045356167-microsoft-excel-vba-voor-dummies

 

[Jack Nouws]

Zo zou het kunnen werken

Private Sub Worksheet_Activate()
  Range("D2").Value = ""
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$D$2" Then
    PictDir = Range("D4").Value
    NoPic = PictDir & "Geen_Foto.jpg"
  
    Image1.Picture = LoadPicture(IIf(Dir(PictDir & Range("D21") & ".jpg") <> vbNullString, PictDir & Range("D21") & ".jpg", NoPic))
    Image2.Picture = LoadPicture(IIf(Dir(PictDir & Range("F9") & ".jpg") <> vbNullString, PictDir & Range("F9") & ".jpg", NoPic))
    Image3.Picture = LoadPicture(IIf(Dir(PictDir & Range("F25") & ".jpg") <> vbNullString, PictDir & Range("F25") & ".jpg", NoPic))
  End If
End Sub

voor hoogte en breedte kun je zoiets als dit in je code toevoegen

  With Image1
    .PictureSizeMode = 3
    .Height = 124
    .Width = 205
  End With

 

[SUVERMO]

Goedenavond Jack.

ik heb geprobeerd met uw code maar krijg een foutmelding
Voor Image1 staat er een rare waarde

hoe deze fout voorkomen

 

[SUVERMO]

Goedenavond vba-experten

jullie hebben al gemerkt dat mijn kennis van vba zeer beperkt is. Op mijn leeftijd, 66, is het al wat moeilijker om iets leren. Toch zou ik het kunnen proberen. Welk handboek kan ik best aankopen?

Deze namiddag en vanavond verschillend dingen geprobeerd maar steeds foutmeldingen

in bijgevoegde jpg's ziet u dat Image1.Target en Image1. de juiste waarde bevatten, bij Image1.Picture staat er .......niet ingesteld
in bijgevoegde Foutmelding.jpg ziet u de foutmelding
in bijgevoegde Image1 Picture geen foto.jpg staat een rare waarde

kan iemand dit oplossen

 

[edmoor]

Maak van:
PictDir = Range("FOTO_MAP").Value

Eens dit:
PictDir = Range("FOTO_MAP").Value & "\"

Zorg er tevens voor dat er in je fotomap een foto staat met de naam Geen_Foto.jpg

 

[Jack Nouws]

Verander cel D4

C:\Users\Vermonden\Pictures\DIEREN

naar dit

C:\Users\Vermonden\Pictures\DIEREN\

 

[edmoor]

Kan ook.
Maar als het in de code staat is het altijd goed.
Of er nu wel of geen \ aan het einde van de celwaarde staat.

 

[Jack Nouws]

Klopt edmoor
bestandje in topic 11 loopt als een trein bij mij

 

[SUVERMO]

Jack en Ed bedankt "" was inderdaad de oorzaak

nogmaals bedankt