Automatisch afbeelding toevoegen.

[PBDier]

Ik wil in excel bij de product informatie de afbeelding van het product toevoegen, de afbeeldingen hebben de zelfde naam als het artikelnummer.

Ik heb een voorbeeld toegevoegd hoe ik het wil hebben alleen zonder afbeeldingen.
Bekijk bijlage Automatisch foto toevoegen, vraag..xlsx
Ik hoop dat jullie mij kunnen helpen.

I.i.g. alvast bedankt.

 

[JeanPaul28]

Om hoeveel foto's en artikelen gaat het, ik veronderstel veel, dan foto's ophalen via HD.
Met een change event op cel artikelnummer met macro foto ophalen .

 

[edmoor]

Hebben alle afbeeldingen dezelfde grootte? Doe er een voorbeeld van zo'n afbeelding bij.

 

[PBDier]

Ze hebben niet de zelfde afbeeldingen, dit zou wel mooier zijn, ik weet niet of dat dat ook mogelijk is om dat meteen aan te passen
Totaal zijn het ruim 50.000 afbeeldingen, ik wil het in meerdere groepen maken, per diersoort en per productgroep en dan gaat het om een aantal van 100 tot 5.000 per groep.

 

[edmoor]

Je bedoeld afmetingen neem ik aan. Natuurlijk is dat meteen aan te passen. Maar als dat de beeldverhouding wijzigt dan worden ze er niet mooier op.

 

[PBDier]

De afbeeldingen kan ik later altijd nog verbeteren door nieuwe foto's te maken.

 

[PBDier]

Om hoeveel foto's en artikelen gaat het, ik veronderstel veel, dan foto's ophalen via HD.
Met een change event op cel artikelnummer met macro foto ophalen .

De foto's staan op de hardeschijf en hoe maak je zo'n macro.
Ik heb het even bekeken maar het is voor mij een groot raadsel hoe het werkt.

 

[edmoor]

Als je wel met VBA weet om te gaan kun je dit gebruiken in achter Blad1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 And IsNumeric(Target.Value) Then
        Call PlaatjeInvoegen(Target.Value, Target.Row - 2)
    End If
End Sub

De routine PlaatjeInvoegen plaats je dan in een module en ziet er dan bijvoorbeeld zo uit:

Sub PlaatjeInvoegen(Plaatje As String, Regel As Integer)
    With Sheets("Blad1").Pictures.Insert("C:\PBDier\" & Plaatje & ".jpg") 'Pad naar plaatje
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 159
            .Height = 45
        End With
        .Left = Sheets("Blad1").Cells(Regel, 1).Left 'De cel waar het
        .Top = Sheets("Blad1").Cells(Regel, 1).Top   'plaatje komt
        .Placement = 1
        .PrintObject = True
    End With
End Sub

Een plaatje is geen waarde van een cel maar een Shape object. Met de grootte en de beeldverhouding zul je moeten spelen.

 

[PBDier]

Ik heb de code bij Blad1(Blad1) - Bald1 (Code) neergezet en in de 2 bovenbalkjes staat worksheet en change.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 And IsNumeric(Target.Value) Then
        Call PlaatjeInvoegen(Target.Value, Target.Row - 2)
    End If
End Sub

Ik heb de code bij Module1 neergezet en in de 2 bovenbalkjes staat algemeen en worksheet_change.

Sub PlaatjeInvoegen(Plaatje As String, Regel As Integer)
    With Sheets("Blad1").Pictures.Insert("D:\PBDier\afbeeldingen\" & Plaatje & ".jpg")
        With .ShapeRange
            .LockAspectRatio = msoFalse
            .Width = 159
            .Height = 45
        End With
        .Left = Sheets("Blad1").Cells(Regel, 1).Left
        .Top = Sheets("Blad1").Cells(Regel, 1).Top
        .Placement = 1
        .PrintObject = True
    End With
End Sub

Alleen als ik op opsla en weer kijk dan zie ik geen afbeelding.

Ik heb de pad naar het plaatje aangepast.

Wat doe ik verkeerd?

 

[edmoor]

Je moet dubbelklikken op Module1 om deze te openen, anders blijf je in de Worksheet sectie. Bij mij worden de plaatjes opgeslagen in het document. Dus ook na het sluiten en weer openen van het document staan de reeds geplaatste plaatjes er nog in. Welke versie van Office gebruik je?

 

[PBDier]

Hier een link met mijn schermafbeelding hoe het nu ingevuld is
https://www.dropbox.com/s/1q8fddkdpj29c9f/Schermafdruk%202014-11-27%2012.44.04.png?dl=0

Ik heb office 2013

 

[edmoor]

Dat ziet er op zich goed uit. Ik heb ook Office 2013 dus waarom dan de plaatjes na het sluiten en weer openen van je document verdwenen zijn zou ik zo niet kunnen zeggen.

 

[PBDier]

ik zie ook geen afbeeldingen als ik het heb ingevoerd, ik heb het nu een keer opgeslagen als:
exel-werkmap met macro's
exel-sjabloom met macro's

maar bij allebei geef afbeeldingen en bij gewoon werkmap krijg ik een foutmelding over VB-project.

 

[edmoor]

maar bij allebei geef afbeeldingen

Geen idee wat je hier bedoeld.

en bij gewoon werkmap krijg ik een foutmelding over VB-project.

Als je zegt een foutmelding te krijgen is het handig als je dan ook even laat weten wat die melding is.
Foutmeldingen zijn er niet om de gebruiker te pesten. Ze geven een indicatie over wat er aan de hand kan zijn.

Daarnaast moet een werkblad met macro's altijd als dusdanig worden opgeslagen (.xlsm)

 

[PBDier]

geef = geen
en de foutmelding is
De volgende zaken kunnen niet worden opgeslagen in werkmappen zonder macro's
- VB-project
Als u een bestand met deze functie wilt opslaan, klikt u op nee en kiest u vervolgens een bestandstype met macro's in de lijst met bestandstype.
Klik op ja om het bestand op te slaan als een werkmap zonder macro's.


Ik ben even een uurtje weg moet met de kinderen naar het consultatie bureau voor inentingen.

 

[edmoor]

Over de foutmelding zegt de laatste zin in m'n vorige post wat er moet gebeuren.
De plaatjes in de map die je gebruikt zijn ook jpg bestanden?
Dus je hebt in die map bijvoorbeeld een plaatje staan met de naam 73366.jpg?

 

[PBDier]

het zijn .jpg bestanden en er staat i.d.d. 2335.jpg, etc.