Afbeeldingen met bestandsnaam in document plaatsen

Status
Niet open voor verdere reacties.
S

SafeConstruct

Gebruiker
Lid geworden
23 apr 2021
Berichten
84
Voor plaatsbeschrijvingen dien ik vele foto's in een rapport (tabelvorm) te plaatsen, wat mij lukt. Is het mogelijk om automatisch (en niet manueel) de bestandsnaam onder deze foto weer te geven ?
 
Dat zul je moeten programmeren, en dat is nog best 'een dingetje' :).
 
Geachte, als nieuw lid en beginneling kan ik sommige reacties niet goed plaatsen, misschien komt dit nog wel. Ik probeer mij te verdiepen als beginneling en stel pas een vraag als ik sloop zit (NB na heel lang zoeken naar dikwijls een speld in een hooiberg).
Mag ik veronderstellen dat na uw antwoord u mij nog goede raad kan geven, of is dit uw sluitend antwoord en moet ik elders om raad vragen ? Kan u mij dan helpen om mijn weg te vinden waar ik wel hulp kan krijgen ?
 
Wat bedoel je met bestandsnaam? De naam van het Word-bestand of de bestandsnaam van de foto? Waar is het voorbeeldbestand?

De filename voeg je in met > tabblad Invoegen > Snelonderdelen > Veld > links kies FileName > OK

Kijk even bij het volgende. How to add filename to picture in Word.
 
Laatst bewerkt:
Beste, dit is gewoon schitterend, ik heb de VBA van de link gebruikt en dit is echt een antwoord op mijn vraag. Beeld je in dat ik zolang aan het zoeken was op google maar blijkbaar heb ik deze link niet gevonden of over het hoofd gezien.
Wat ik niet nodig heb ik de volledige 'pad' (C:\*) maar enkel de naam van de foto zelf (*.jpg of *.bmp, ...).
Ziehier de macro
Code: 
Sub PicWithCaption()
    Dim xFileDialog As FileDialog
    Dim xPath, xFile As Variant
    On Error Resume Next
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFileDialog.Show = -1 Then
        xPath = xFileDialog.SelectedItems.Item(1)
        If xPath <> "" Then
            xFile = Dir(xPath & "\*.*")
            Do While xFile <> ""
                If UCase(Right(xFile, 3)) = "PNG" Or _
                    UCase(Right(xFile, 3)) = "TIF" Or _
                    UCase(Right(xFile, 3)) = "JPG" Or _
                    UCase(Right(xFile, 3)) = "GIF" Or _
                    UCase(Right(xFile, 3)) = "BMP" Then
                    With Selection
                        .InlineShapes.AddPicture xPath & "\" & xFile, False, True
                        .InsertAfter vbCrLf
                        .MoveDown wdLine
                        .Text = xPath & "\" & xFile & Chr(10)
                        .MoveDown wdLine
                    End With
                End If
                xFile = Dir()
            Loop
        End If
    End If
End Sub
 

Bijlagen

  • Testfile met pictures HM.docx
    474,3 KB · Weergaven: 63
Wat ik niet nodig heb ik de volledige 'pad' (C:\*) maar enkel de naam van de foto zelf (*.jpg of *.bmp, ...).
Klik om te vergroten...
Verander
Code: 
.Text = xPath & "\" & xFile & Chr(10)
in
Code: 
.Text = xFile & Chr(10)
 
Ik was zelf bezig om de bestandsnaam in het bijschrift terzetten, wat een stuk lastiger is. Maar als je met deze oplossing tevreden bent (die je denk ik ook wel in dit forum had kunnen vinden ;)) dan stop ik daar mee. :).
 
Het kan zijn dat je je vraag niet goed gesteld hebt, en dat de aangedragen code dus exact is wat je zoekt. Kan ik niet beoordelen. Maar ik zie zelf nogal wat procedurele 'slordigheden'. Zoals: waarom zou je een dialoogvenster openen en vervolgens alle bestanden uit die map inlezen en daarna pas de plaatjes eruit filteren? Vind ik niet logisch. Slimmer is, denk ik, om eerst de afbeeldingen selecteren (gefilterd in het dialoogvenster op het juiste type) en vervolgens de gekozen selectie te verwerken. Dat kan dan op twee manieren: stuk voor stuk (dialoogvenster met één afbeelding), of meerdere afbeeldingen tegelijk selecteren en die dan inlezen. Voor beide opties gebruik ik deze functies:

Code: 
Sub AfbeeldingBijschrift()
Dim xFD As FileDialog
Dim xFile As Variant, xName As String
    
    On Error Resume Next
    Set xFD = Application.FileDialog(msoFileDialogFilePicker)
    With xFD
        .Filters.Add "Afbeeldingen", "*.png; *.jpg; *.jpeg", 1
        .Filters.Add "RAW", "*.bmp; *.tif; *.tiff", 2
        .InitialFileName = ActiveDocument.Path & "\"
        .AllowMultiSelect = False
        If .Show = -1 Then
            xFile = .SelectedItems.Item(1)
            If xFile = "" Then Exit Sub
        End If
        xName = Split(xFile, "\")(UBound(Split(xFile, "\")))
        With Selection
            .InlineShapes.AddPicture xFile, False, True
            .InsertAfter vbCrLf
            .MoveDown wdLine
            .Text = xName & Chr(10)
            .MoveDown wdLine
        End With
    End With
End Sub

En voor meerdere afbeeldingen deze:
Code: 
Sub AfbeeldingenBijschrift()
Dim xFD As FileDialog
Dim vrtSelectedItem As Variant, arr As Variant
Dim xFile As String, xName As String, i As Integer
    
    On Error Resume Next
    Set xFD = Application.FileDialog(msoFileDialogFilePicker)
    With xFD
        .Filters.Add "Afbeeldingen", "*.png; *.jpg; *.jpeg", 1
        .Filters.Add "RAW", "*.bmp; *.tif; *.tiff", 2
        .InitialFileName = ActiveDocument.Path & "\"
        .AllowMultiSelect = True
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                If xFile <> "" Then xFile = xFile & ";"
                xFile = xFile & vrtSelectedItem
            Next
            If xFile = "" Then Exit Sub
        End If
        'Ingelezen bestanden verwerken
        arr = Split(xFile, ";")
        For i = LBound(arr) To UBound(arr)
            xFile = arr(i)
            xName = Split(arr(i), "\")(UBound(Split(arr(i), "\")))
            With Selection
                .InlineShapes.AddPicture xFile, False, True
                .InsertAfter vbCrLf
                .MoveDown wdLine
                .Text = xName & Chr(10)
                .MoveDown wdLine
            End With
        Next i
    End With
End Sub

Kijk maar even of je er wat aan hebt.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan