Snelonderdeel met foto

  • Onderwerp starter Onderwerp starter GJKok
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

GJKok

Gebruiker
Lid geworden
1 sep 2016
Berichten
7
Beste leden,

Geruime tijd maak ik al gebruik van het helpmij forum door her en der informatie weg te plukken, te combineren en zo steeds mijn werken te voltooien. Echter ben ik nu op het punt dat ik door de bomen het bos niet meer zie en daarom ben ik mij maar eens gaan registreren :).


Ik ben bezig met een bestandje dat snel, veel foto's in een bepaalde kolom moet in kunnen voegen waarbij het eigenlijk steeds een nieuwe tabel is die aangemaakt wordt.

Wat ik tot nu toe geprobeerd heb:
Ik heb een bepaalde tabel stijl ingevoegd in mijn "Quick Parts Gallery". (https://cybertext.wordpress.com/201...t-a-formatted-table-and-an-automated-caption/). Op deze pagina staat ook een stukje VBA code, en dit heb ik geprobeerd aan te vullen met code waarbij in de 2e rij, 4e kolom een afbeelding ingevoegd moet worden. Vervolgens moet het scriptje blijven herhalen voor alle geselecteerde foto's.

Heel wat knutsel en plakwerk al bij elkaar gezocht, maar ik kom er gewoon even niet meer uit :P.

Is er iemand die mij kan helpen?
 

Bijlagen

Laatst bewerkt:
Ik zou zeggen: doe je Word document met macro erbij, dan zien we wat je gedaan hebt.
 
Kun je svp het bestand hier uploaden in plaats van op zo'n verschrikkelijke site ?
 
Laatst bewerkt:
Hopelijk is het nu wel goed... Eindelijk de bijlage optie gevonden... Die zat verstopt achter "de advanced aanpasfunctie" :rolleyes:
 
Ik dacht niet dat een docx bestand macro's bevat.

De macrorecorder doet wonderen:

Code:
Sub M_snb()
   With ActiveDocument.Tables(1).Cell(2, 4).Range.InlineShapes.AddPicture("G:\OF\Peer.jpg", False, True)
        .LockAspectRatio = -1
        .Height = ActiveDocument.Tables(1).Rows(2).Height
    End With
   
   With ActiveDocument.Tables(1).Cell(2, 6).Range.InlineShapes.AddPicture("G:\OF\Framboos.jpg", False, True)
        .LockAspectRatio = -1
        .Height = ActiveDocument.Tables(1).Rows(2).Height
   End With
End Sub
 
Laatst bewerkt:
Als ik het bestand hier open, dan staat de macro er wel gewoon in? Maar dat zal wel zijn omdat het lokaal is zeker? Zoals je al merkt gaat het niet van een leien dakje, en ik voel me bij elk bericht ook dommer en dommer worden :rolleyes: :( Maar goed, zodra ik een dotm bestand bij wil voegen, wil dat niet. AL met al, hieronder de macro zoals ik die bij elkaar geplakt hebt in het bestandje van de eerste post :)

Code:
Sub AddPics()
    Application.ScreenUpdating = False
    Dim oTbl As Table, i As Long, j As Long, StrTxt As String
     'Select and insert the Pics
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select image files and click OK"
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
        .FilterIndex = 2
        If .Show = -1 Then
With CaptionLabels("Table")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen

    Selection.InsertCaption Label:="Table", TitleAutoText:="", Title:="", _
        Position:=wdCaptionPositionAbove, ExcludeLabel:=0
    Selection.TypeText Text:="   Inspectie tabel"
    Selection.TypeParagraph

    ActiveDocument.AttachedTemplate.BuildingBlockEntries("inspection_table" _
      ).Insert Where:=Selection.Range, RichText:=True
                 'Insert the Picture
                ActiveDocument.InlineShapes.AddPicture _
                FileName:=.SelectedItems(i), LinkToFile:=False, _
                SaveWithDocument:=True, Range:=oTbl.Rows(1).Cells(4).Range
               End With
            Next
        Else
        End If
    End With
    Application.ScreenUpdating = True
End Sub
End Sub
 
Pak een dotm bestand in. zip wordt hier altijd geaccepteerd.

Maar als je jouw macro vervangt door de mijne ben je klaar.
 
Nou niet helemaal eigenlijk maar met het opnemen wordt het wel iets vergemakkelijkt :)

Nu werkt het juiste buildingblock inderdaad, maar er wordt nu elke keer de foto geselecteerd die ik de eerste keer geselecteerd heb.

Ik kan op deze manier niet ineens 50 foto's selecteren waarvoor die steeds dezelfde handeling herhaald.

Daarnaast zet hij, zodra ik de macro nog eens uitvoer de foto niet in de tabel, maar onder de tabel. Dit terwijl de foto steeds op dezelfde plaats in de tabel moet verschijnen. (Rij 2, kolom 4). Als dat nog zou kunnen, wordt ik heel erg blij :)

Code:
Sub Opgenomen()
'
' Opgenomen Macro
'
'
    Application.Templates( _
        "C:\Users\gebruiker\AppData\Roaming\Microsoft\Document Building Blocks\1043\16\Building Blocks.dotx" _
        ).BuildingBlockEntries("Inspectietabel").Insert Where:=Selection.Range, _
        RichText:=True
    Selection.InlineShapes.AddPicture FileName:= _
        "C:\Users\gebruiker\Pictures\IMG_7029.jpg", LinkToFile:=False, _
        SaveWithDocument:=True
    Selection.TypeParagraph
End Sub
 
Laatst bewerkt:
Zie alsjeblieft de eerste post nog een keer om te zien wat de bedoeling is. Ik heb een bepaald tabelformat opgezet. Deze staat als buildingblock opgenomen.

Wanneer ik mijn macro uitvoer moet het volgende gebeuren:

0. Openen venster om foto's te selecteren

1. Buildingblock wordt geselecteerd
2. In de 2e rij 4e kolom wordt een foto ingevoegd
3. Onder de tabel wordt een witregel ingevoegd

1. Buildingblock wordt geselecteerd
2. In de 2e rij 4e kolom wordt een foto ingevoegd
3. Onder de tabel wordt een witregel ingevoegd

1. Buildingblock wordt geselecteerd
2. In de 2e rij 4e kolom wordt een foto ingevoegd
3. Onder de tabel wordt een witregel ingevoegd

enzovoorts

Totdat alle geselecteerde foto's op deze manier verwerkt zijn.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan