Inserare de imagini în tabel cu 2-4 coloane
Inserare de imagini în tabel cu două, trei sau patru coloane
Instrucţiunile de mai jos se copie în aplicația Visual Basic, fereastra Code (detalii pe pagina Macrocomenzi )
Sub AdaugareImaginiInTabel()
'am folosit si adaptat codul de pe pagina
'http://www.vbaexpress.com/forum/showthread.php?44473-Insert-Multiple-Pictures-Into-Table-Word-With-Macro
'initial, codul era gandit pentru doua coloane
Dim nrcol As String 'a fost ales String (nu Integer) pentru a putea capta eroarea 13
Application.ScreenUpdating = False
nrcol = InputBox("Introduceti numarul coloanelor" & vbNewLine & "(min. 2, max. 4)")
If StrPtr(nrcol) = 0 Then
MsgBox "Nu ati dat click pe OK. Iesire din program..."
Exit Sub
End If
If nrcol < 2 Or nrcol > 4 Then
nrcol = InputBox("Ati introdus " & nrcol & " coloane." & vbNewLine & _
"Numarul coloanelor trebuie sa fie de 2, 3 sau 4." & vbNewLine & _
"Daca alegeti alta valoare, programul se va termina.")
If StrPtr(nrcol) = 0 Then
MsgBox "Nu ati dat click pe OK. Iesire din program..."
Exit Sub
End If
If nrcol < 2 Or nrcol > 4 Then
MsgBox "Iesire din program..."
Exit Sub
End If
Else
nume_img = MsgBox("Pastrez numele fisierului sub imagine?", vbYesNo + vbQuestion, "Cu nume fisier")
End If
'formatare text in locul unde se adauga tabelul
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
'.MirrorIndents = False '!!! doar pentru Office mai nou
'.TextboxTightWrap = wdTightNone '!!! doar pentru Office mai nou
End With
Dim oTbl As Table, nrfoto As Long, j As Long, k As Long, StrTxt As String
'Selecteaza si insereaza imaginile
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selectati imaginile si click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then '-1 click OK, 0 click X sau Cancel
'Adaug tabel cu nrcol coloane si 2 linii pentru a prelua imaginile
'expression .Add(Range, NumRows, NumColumns, DefaultTableBehavior, AutoFitBehavior)
Set oTbl = Selection.Tables.Add(Selection.Range, 2, nrcol)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
If nrcol = 2 Then
.Columns.Width = CentimetersToPoints(8)
ElseIf nrcol = 3 Then
.Columns.Width = CentimetersToPoints(5)
ElseIf nrcol = 4 Then
.Columns.Width = CentimetersToPoints(4)
End If
End With
For nrfoto = 1 To .SelectedItems.Count
If nrcol = 2 Then
j = Int((nrfoto + 1) / 2) * 2 - 1 ' j este numarul liniei impare in care se insereaza imaginea
k = (nrfoto - 1) Mod 2 + 1 'k este nr coloanei in care se insereaza imaginea
ElseIf nrcol = 3 Then
j = 2 * Int((nrfoto + 2) / 3) - 1
k = (nrfoto - 1) Mod 3 + 1
ElseIf nrcol = 4 Then
j = 2 * Int((nrfoto + 3) / 4) - 1
k = (nrfoto - 1) Mod 4 + 1
End If
'Adauga cate randuri sunt necesare
If j > oTbl.Rows.Count Then
oTbl.Rows.Add
oTbl.Rows.Add
End If
'Insereaza imagine
ActiveDocument.InlineShapes.AddPicture _
FileName:=.SelectedItems(nrfoto), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
'Preia numele imaginii pentru Caption
StrTxt = Split(.SelectedItems(nrfoto), "\")(UBound(Split(.SelectedItems(nrfoto), "\")))
StrTxt = Split(StrTxt, ".")(0)
'Insereaza numele imaginii in celula de sub imagine
If nume_img = vbYes Then
With oTbl.Rows(j + 1).Cells(k).Range
'inainte de Enter
.InsertBefore vbCr
.Text = "Nr.inv.: " & StrTxt ' varianta: se poate adauga text inaintea numelui imaginii
.Text = StrTxt
End With
Else
'do nothing
End If
Next
Else
End If
End With
Application.ScreenUpdating = True
End Sub
Modul în care se poate folosi macrocomanda este prezentat pe YouTube: https://youtu.be/OvvYhQguBuM
Am găsit un supliment (add-in) care face acelaşi lucru, dar are mai multe opţiuni, pe pagina:
http://gregmaxey.com/word_tip_pages/photo_gallery_add_in.html