Opgelost foto vanuit excel naar word

[mrnico]

Hallo ik ben aan het probeer een deel uit een excel lijst automatische naar word te zetten.
echter loop ik tegen een uitdaging aan.
de foto werkt momenteel alleen als PAD plaats van rechtsteeks de foto uit de cel.
en de foto's kommen allemaal boven aan te staan plaats van in de regel die gecopieerd word

Sub ZetLijstEnFotoNaarWord()
    Dim wdApp As Object, wdDoc As Object
    Dim ws As Worksheet
    Dim laatsteRij As Long, i As Long
    Dim fotoPad As String
    


    Set ws = ThisWorkbook.Sheets("Lijst met punten")
    laatsteRij = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Start Word
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    ' Lus door de Excel lijst (start bij rij 2, na de koptekst)
    For i = 2 To laatsteRij
        ' Tekst toevoegen
        wdDoc.Content.InsertAfter ws.Cells(i, 1).Value & vbCrLf
        wdDoc.Content.InsertAfter ws.Cells(i, 3).Value & vbCrLf
        wdDoc.Content.InsertAfter ws.Cells(i, 4).Value & vbCrLf
      

            
    
        

        ' Foto invoegen op basis van bestandspad in kolom 5 (E)

        fotoPad = ws.Cells(i, 5).Value
        If fotoPad <> "" And Dir(fotoPad) <> "" Then
            wdDoc.Content.InlineShapes.AddPicture Filename:=fotoPad, _
                LinkToFile:=False, SaveWithDocument:=True, Range:=wdDoc.Content
        End If
        
  

        ' Extra witregel tussen items
        wdDoc.Content.InsertAfter vbCrLf & "----------------------------------" & vbCrLf
    Next i

    MsgBox "Klaar met exporteren naar Word!"
End Sub

Ik hoop dat iemand mij kan helpen

 

[peter59]

Probeer deze code eens. Die code is absoluut niet van mij maar van AI Claude.
Maak eerst een kopie voordat je de code gebruikt.

Sub ZetLijstEnFotoNaarWord()
    Const wdCollapseEnd As Long = 0

    Dim wdApp As Object, wdDoc As Object
    Dim rng As Object
    Dim ws As Worksheet
    Dim laatsteRij As Long, i As Long
    Dim shp As Shape
    Dim fotoGevonden As Boolean

    Set ws = ThisWorkbook.Sheets("Lijst met punten")
    laatsteRij = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Start Word
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    ' Eén Range-object dat we steeds naar het einde schuiven
    Set rng = wdDoc.Content
    rng.Collapse Direction:=wdCollapseEnd

    For i = 2 To laatsteRij

        ' --- Tekst toevoegen (steeds op de huidige eindpositie) ---
        rng.InsertAfter ws.Cells(i, 1).Value & vbCrLf
        rng.Collapse Direction:=wdCollapseEnd

        rng.InsertAfter ws.Cells(i, 3).Value & vbCrLf
        rng.Collapse Direction:=wdCollapseEnd

        rng.InsertAfter ws.Cells(i, 4).Value & vbCrLf
        rng.Collapse Direction:=wdCollapseEnd

        ' --- Foto zoeken die op deze rij in kolom E staat ---
        fotoGevonden = False
        For Each shp In ws.Shapes
            If Not shp.TopLeftCell Is Nothing Then
                If shp.TopLeftCell.Row = i And shp.TopLeftCell.Column = 5 Then
                    shp.Copy
                    rng.Paste
                    rng.Collapse Direction:=wdCollapseEnd
                    fotoGevonden = True
                    Exit For
                End If
            End If
        Next shp

        ' Fallback: als er toch een bestandspad in kolom E staat
        If Not fotoGevonden Then
            Dim fotoPad As String
            fotoPad = ws.Cells(i, 5).Value
            If fotoPad <> "" And Dir(fotoPad) <> "" Then
                wdDoc.InlineShapes.AddPicture Filename:=fotoPad, _
                    LinkToFile:=False, SaveWithDocument:=True, Range:=rng
                rng.Collapse Direction:=wdCollapseEnd
            End If
        End If

        ' --- Scheidingslijn ---
        rng.InsertAfter vbCrLf & "----------------------------------" & vbCrLf
        rng.Collapse Direction:=wdCollapseEnd

    Next i

    MsgBox "Klaar met exporteren naar Word!"
End Sub

Belangrijkste wijzigingen op een rij:

1. rng wordt na élke invoeging (tekst én foto) gecollapset naar het einde, zodat alles netjes na elkaar komt in plaats van vooraan.
2. Voor de foto wordt eerst gezocht naar een Shape op de rij (kolom E) via shp.TopLeftCell. Die wordt gekopieerd en met rng.Paste op de juiste plek geplakt.
3. Staat er toch nog een bestandspad in kolom E (geen shape gevonden), dan valt de code terug op de oude AddPicture-methode, nu met Range:=rng in plaats van Range:=wdDoc.Content.

Eén aandachtspunt:
shp.TopLeftCell.Column = 5 gaat ervan uit dat de afbeelding echt in kolom E begint. Staat de foto een beetje "scheef" over meerdere cellen, dan kun je die check versoepelen (bijv. alleen op Row matchen, of een bereik van kolommen toestaan).

 

[Enigmasmurf]

Nu kon ik toch echt niet laten om Claude's oplossing eens te bekijken, en neen, ik heb niet de indruk dat dit was waar TS naar zocht.

@mrnico,
Als ik het goed inschat moet er aan je eigen code niet zo veel veranderen.
Vervang

If fotoPad <> "" And Dir(fotoPad) <> "" Then
  wdDoc.Content.InlineShapes.AddPicture Filename:=fotoPad, _
    LinkToFile:=False, SaveWithDocument:=True, Range:=wdDoc.Content
End If

eens door

If fotoPad <> "" And Dir(fotoPad) <> "" Then
  Set einde = wdDoc.Content
  einde.collapse wdCollapseEnd
  wdDoc.Content.InlineShapes.AddPicture Filename:=fotoPad, _
    LinkToFile:=False, SaveWithDocument:=True, Range:=einde
End If

En o ja, "werkt momenteel alleen als PAD plaats van rechtsteeks de foto uit de cel", dat heb je natuurlijk zelf zo ingesteld met "fotoPad = ws.Cells(i, 5).Value"...

 

[snb]

of gewoon zo:

Sub M_snb()
    sn = Sheets("Lijst met punten").Cells(1).CurrentRegion
   
   With CreateObject("word.document")
     For j = 2 To UBound(sn)
        .Content.InsertAfter Join(Array(sn(j, 1), sn(j, 3), sn(j, 4)), vbCr)

        If Dir(sn(j, 5)) <> "" Then .InlineShapes.AddPicture sn(j, 5), , , .Characters.last
        .Content.InsertAfter vbCr & string(20,"-") & vbCr
      Next
      .Windows(1).Visible = True
    End With
End Sub

PS. Ik vind de meerwaarde van een forum het aanbieden van suggesties die een vraagsteller niet elders kan vinden. Code van AI valt daar niet onder.

 

[peter59]

PS. Ik vind de meerwaarde van een forum het aanbieden van suggesties die een vraagsteller niet elders kan vinden. Code van AI valt daar niet onder.

VBA is een taal die je moet leren met een grammatica- en een woordenboek.

Dan zou je eigenlijk ook antwoorden uit documentatie, boeken e.d. moeten uitsluiten (Zie je eigen handtekening). De waarde zit wat mij betreft niet in de herkomst van een oplossing, maar in de juistheid en de uitleg ervan. En juist die uitleg ontbreekt soms nog wel eens, hè @snb?

 

[OctaFish]

En toch heeft @snb gelijk. Zo'n beetje elk antwoord van @peter59 begint met: "Claude zegt dit:" Leg de nietsvermoedende lezer eens uit wat dan precies jouw meerwaarde is? Of ben jij de enige met een Claude account?

 

[peter59]

Of ben jij de enige met een Claude account?

Nee hoor, zeker niet.
Er zijn genoeg forumleden die AI gebruiken en daar vervolgens iets mee doen op het forum.
Ik ben alleen zo netjes om erbij te vermelden dat de informatie (deels) uit AI komt.
Voor mij is AI gewoon een hulpmiddel. Het geeft vaak een prima eerste aanzet of brengt informatie overzichtelijk bij elkaar. Daarna kun je er zelf nog kritisch naar kijken, aanvullen of je eigen mening aan toevoegen.
Dat zie je in dit topic eigenlijk ook wel terug. Zie #3

Mijn persoonlijke mening?
AI heeft de toekomst.
Je moet het alleen gebruiken waarvoor het bedoeld is: als hulpmiddel, niet als vervanging van je eigen verstand.

 

[snb]

SNB zegt dit: in een grammatica staan regels, in een woordenboek staan elementen, waarop regels kunnen worden toegepast. Noch een grammatica, noch een woordenboek bevat antwoorden. Het zou fijn zijn eerst goed te lezen (en goed na te denken) voordat je een reaktie plaatst waaruit blijkt wat je competenties zijn.

 

[peter59]

@snb
Ik lees je reactie anders. Ik beweer ook niet dat een grammatica of woordenboek kant-en-klare antwoorden bevat.
Mijn punt is juist dat AI die bronnen kan combineren en verwerken tot een bruikbaar antwoord.
Daar kun je het mee eens of oneens zijn, maar laten we het dan over de inhoud hebben en niet over elkaars competenties.

 

[Enigmasmurf]

En toch heeft @snb gelijk. Zo'n beetje elk antwoord van @peter59 begint met: "Claude zegt dit:"

Peter59 was me al net voor, maar toch gooi ook ik er nog een persoonlijke mening tegenaan. Die zou begonnen zijn met "En toch heeft peter59 gelijk" want het is me al meermaals opgevallen dat aangedragen oplossingen duidelijk van AI komen, maar dan zonder bronvermelding.
Trouwens, als snb gelijk heeft, moet dan niet het (en bij uitbreiding elk) forum opgedoekt worden? Alles kan namelijk elders door iedereen gevonden worden!