foto wijzigen, kolommen verbergen

[SUVERMO]

Goedenavond iedereen,

kunnen kolommen verborgen worden aan de hand van celinhoud?

Kunnen FOTO 1, FOTO 2 en FOTO 3 zich automatisch aanpassen als er een ander nummer wordt geselecteerd in cel D2

verdere uitleg staat in bijgevoegd bestand in kolom O

 

[SUVERMO]

na wat zoeken op deze site heb ik volgende kunnen maken om kolommen te verbergen

Private Sub Worksheet_Change(ByVal Target As Range)
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

Dit werkt prima

Voor de foto's heb ik iets gevonden en de code als volgt aangepast

Const PictDir As String = "C:\Users\Vermonden\Pictures\DIEREN\"

Private Sub Worksheet_Activate()
    Image1.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$18" Then
    If Not Dir(PictDir & Target & ".jpg") = vbNullString Then
        With Image1
            .Picture = LoadPicture(PictDir & Target & ".jpg")
            .PictureSizeMode = 1
        End With
    Else
        Image1.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    End If
End If
End Sub

dit is bewaard in het bestand "gevonden op site.xlsm".
dit werkt prima met de foto's van "DIEREN.zip". Deze verschijnen in de rechthoek in de kolom B tussen rijen 26 en 36.
deze rechthoek kan ik niet selecteren, wat is dat? Hoe maakt men zoiets?

hoe kan kan men iets dergelijks maken dat voor de 3 foto's in "test2.xlsm".

 

[Jack Nouws]

Met shaperange .height en .width kun je een vaste maat aangeven

        With Image1.Picture = LoadPicture(PictDir & Target & ".jpg")
            .PictureSizeMode = 1
            
            With .ShapeRange
              .Height = 80
              .Width = 120
            End With
        End With

 

[SUVERMO]

Bericht #2 is vervolledigd
kan iemand mij op weg helpen

 

[SUVERMO]

Na in het tabblad ontwikkelaars de ontwerpmodus te hebben geactiveerd kon ik verder proberen.

probleem nu is dat er eerst 2 maal op de cellen D21, F9, F25 geklikt moet worden om de foto juist te krijgen.
Zou iemand dit willen oplossen a.u.b.

kunnen de foto's gemaximaliseerd worden tot de rode kader met de behoud van de originele fotoverhoudingen.

 

[Jack Nouws]

dit zou een mogelijkheid kunnen zijn

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> "" Then
    If Not Dir(PictDir & Target & ".jpg") = vbNullString Then
        With Image1
            .Picture = LoadPicture(PictDir & Target.Value & ".jpg")
            .PictureSizeMode = 1
            .Top = 96.6
            .Left = 23.4
            .Height = 139.2   '80
            .Width = 196.2    '120
        End With
        
      If Range("F9") <> "" Then
        With Image2
          etc...
    Else
        Image1.Picture = LoadPicture(PictDir & "Geen_Foto.jpg")
    End If
End If

Wie weet heb je HIER iets aan.

 

[SUVERMO]

Beste Jack,

heel veel dank voor uw hulp, het is eindelijk gelukt.
Ik heb wel wat aangepast aan de eigenschappen van Image1,2 en 3, (via Ontwikkelaars/Ontwerpmodus) zie bijgevoegd plaatje.

 

[SUVERMO]

Beste Jack,

hierbij de gebruikte code

Const PictDir As String = "C:\Users\Vermonden\Pictures\DIEREN\"

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