Zoeken en filteren met tekst en foto!

[Noord2011]

Beste mensen,

Ik wil dmv van een knop foto koppelen met tekst.

In kolom B “Sheet Overzicht” staan tekst die gekoppeld dient te worden met foto, bijv tekst 1 toont foto 1 in column A.

[B7, tekst 1 toont in A7, foto 1]
[B8, tekst 2 toont in A8, foto 2]
[B9, tekst 3 toont in A9, foto 3]

Dmv een knop automatisch foto projecteren in kolom A volgens tekst naam in kolom B!

En vervolgens moet de foto na filter ook mee ga. Als ik filter op tekst 2 moet alleen de foto behoord bij tekst 2 getoond worden.

Al de foto’s staan in “Sheet Bib foto”. De foto’s zijn genoemd foto 1, foto 2 etc.

Wie kan me helpen.

Bestaand kan niet up geload worden het lukt mij niet!!!

Alvast bedankt.

 

[Noord2011]

Als het te moeilijk wordt kan ook:

De foto's staan in de map bijv C:/foto. (diverse foto's met unike naam)

In kolum B5:B50 staan de namen van de foto's

Als de cel tekst = dan de naam foto, dan dient de foto in cel A te verschijnen.

Bijv in B5 staan tekst "boom" dient in cel A5 de foto boom te verschijnen.

Mischien dit is makkelijk?

 

[Wigi]

Hier is uitgewerkte code:

Sub voegpicturesin()

    Const sMap As String = "C:\foto\"
    
    Dim r As Range
    
    For Each r In [B5:B50].SpecialCells(2)
    
        If Len(Dir(sMap & r.Text)) Then
        
            With ActiveSheet.Pictures.Insert(sMap & r.Text)
            
                .ShapeRange.LockAspectRatio = False
                
                .Top = r.Top
                .Left = r.Offset(, -1).Left
                .Height = r.Height
                .Width = r.Offset(, -1).Width
                
            End With
        
        End If
    
    Next

End Sub

 

[Noord2011]

Bekijk bijlage Insert pic1.xls

Ik heb de code in een bestand gecopier maar doet niks??

Mischien doe ik iets fout?

Een map gemaakt met foto op C:\foto

Zie bijlage.

 

[Wigi]

Ofwel moeten de cellen de extensie van de foto's bevatten (jpg, png, ...), ofwel moet je dit in de macro aanpassen.

De macro gaat ervan uit dat de extensie in de cellen voorkomt.

 

[Noord2011]

De foto namen in excel B5:B50 zijn gewoon tekst. bijv "Boom of E0412"

De macro moet zorgen dat de foto in map C:\foto in kolum a voor het tekst boom komt!

Mv/Gr

 

[Wigi]

De foto namen in excel B5:B50 zijn gewoon tekst. bijv "Boom of E0412"

De macro moet zorgen dat de foto in map C:\foto in kolum a voor het tekst boom komt!

Dat is een mooi doel, maar als je niet zegt of het om een jpg of png of bmp of weet ik veel welke extensie het is, dan ga je nooit de file kunnen inladen als afbeelding (behoudens loopen tot de bestandsnaam matcht maar dat is dan ook maar een omweg).

 

[Noord2011]

Ok,

Kan het tekst ".jpg" achter de teksten in B5:B50 met macro automatisch genereren?, vervolgens foto inladen

Of het tekst ".jpg" met de macro achter de teksten plaatsen in de VBA code?

Mv/Gr

 

[Wigi]

Dit had je ongetwijfeld ook wel zelf kunnen vinden:

Sub voegpicturesin()

    Const sMap As String = "C:\foto\"
    
    Dim r As Range
    
    For Each r In [B5:B50].SpecialCells(2)
    
        If Len(Dir(sMap & r.Text[B][U] & ".jpg"[/U][/B])) Then
        
            With ActiveSheet.Pictures.Insert(sMap & r.Text[B][U] & ".jpg"[/U][/B])
            
                .ShapeRange.LockAspectRatio = False
                
                .Top = r.Top
                .Left = r.Offset(, -1).Left
                .Height = r.Height
                .Width = r.Offset(, -1).Width
                
            End With
        
        End If
    
    Next

End Sub

 

[Wigi]

Of voor de liefhebbers:

Sub voegpicturesin()

    Const sMap As String = "C:\foto\#.jpg"
    
    Dim r As Range
    
    For Each r In [B5:B50].SpecialCells(2)
    
        If Len(Dir(Replace(sMap, "#", r.Text))) Then
        
            With ActiveSheet.Pictures.Insert(Replace(sMap, "#", r.Text))
            
                .ShapeRange.LockAspectRatio = False
                
                .Top = r.Top
                .Left = r.Offset(, -1).Left
                .Height = r.Height
                .Width = r.Offset(, -1).Width
                
            End With
        
        End If
    
    Next

End Sub

 

[Noord2011]

Bekijk bijlage Pic filter.xls

Ik ben zover,

Alleen gaat het filteren niet helemaal goed. Zij bijlage

Bijv. als ik op huis filter gaat de foto van hond niet weg?

Wie kan me helpen!

 

[Wigi]

Doe een rechtermuisklik op de foto's en bij de eigenschappen stel je in dat de afbeelding moet herschalen en verplaatsen met de cellen. 2de tabje, eerste optie (van 3).