billed macro i word

I to rækker - første til billede - anden til billedets navn?
Hvormange pr. side?

Du kan downloade et word makro eksempel her fra http://www.smartoffice.dk/Tips/Eksperten/Index.asp til håndtering af billeder - se nederst på siden

I 2 rækker, med teksten under hvert billed og 3 billeder i lodret...

Billed 1    | Billed 3
Tekst 1    | Tekst 3
            |
Billed 2    | Billed 5
Tekst 2    | Tekst 5
            |
Billed 3    | Billed 6
Tekst 3    | Tekst 6

Groft eksempel

Har et udkast klar - hvis du sender en mail til: pb@supertekst-it.dk
-
så returnerer jeg skabelon - worddokument m/tabel samt selve system-dokumentet m/VBA-koden.

Const billedMappe = "D:\BilledDataBasePB\Arkiverede Billeder\"              'Tilpasses
Const skabelonSti = "C:\Documents and Settings\pb\Skrivebord\0811Billeder\" 'Tilpasses
Rem ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Dim nr, sideNr, resDoc
Sub xAutoOpen()
    behandlingAfBilleder billedMappe
End Sub
Private Sub behandlingAfBilleder(mappe)
Dim fs, f, f1, fc
Dim ræk, kol

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappe)
    Set fc = f.Files
   
    nr = 1
    sideNr = 0
    ræk = 1
    kol = 1
   
    åbnResultatDokument skabelonSti + "BilledSkabelon.dot"
    Application.ScreenUpdating = False
   
    For Each f1 In fc
        indsætBillede f1.Name, ræk, kol
       
        ræk = ræk + 2
        If ræk > 5 Then
            If kol = 1 Then
                ræk = 1
                kol = 2
            Else
                kol = 1
                ræk = 1
                side = side + 1
                åbnResultatDokument skabelonSti + "BilledSkabelon.dot"
            End If
        End If
        nr = nr + 1
    Next
   
    Application.ScreenUpdating = True
    lukResultatDokument
End Sub
Private Sub indsætBillede(bfil, ræk, kol)
    Set cc = resDoc.ActiveDocument.Tables(sideNr)
    cc.Cell(ræk, kol).Select

    resDoc.Selection.InlineShapes.AddPicture FileName:= _
    billedMappe + bfil, LinkToFile:=False, _
    SaveWithDocument:=True

    resDoc.ActiveDocument.InlineShapes(nr).Fill.Visible = msoFalse
    resDoc.ActiveDocument.InlineShapes(nr).Fill.Solid
    resDoc.ActiveDocument.InlineShapes(nr).Fill.Transparency = 0#
    resDoc.ActiveDocument.InlineShapes(nr).Line.Weight = 0.75
    resDoc.ActiveDocument.InlineShapes(nr).Line.Transparency = 0#
    resDoc.ActiveDocument.InlineShapes(nr).Line.Visible = msoFalse
    resDoc.ActiveDocument.InlineShapes(nr).LockAspectRatio = msoFalse
   
    resDoc.ActiveDocument.InlineShapes(nr).Height = 155.9
    resDoc.ActiveDocument.InlineShapes(nr).Width = 141.75

    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.Brightness = 0.5
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.Contrast = 0.5
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.ColorType = msoPictureAutomatic
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.CropLeft = 0#
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.CropRight = 0#
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.CropTop = 0#
    resDoc.ActiveDocument.InlineShapes(nr).PictureFormat.CropBottom = 0#
       
    With resDoc.ActiveDocument.Tables(sideNr)
        .Cell(ræk + 1, kol).Select
        resDoc.Selection.TypeText Text:=bfil
    End With
   
'        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'    End With
End Sub
Private Sub indsætBillede2(bfil, ræk, kol)
    Selection.InlineShapes(1).Fill.Visible = msoFalse
    Selection.InlineShapes(1).Fill.Solid
    Selection.InlineShapes(1).Fill.Transparency = 0#
    Selection.InlineShapes(1).Line.Weight = 0.75
    Selection.InlineShapes(1).Line.Transparency = 0#
    Selection.InlineShapes(1).Line.Visible = msoFalse
    Selection.InlineShapes(1).LockAspectRatio = msoFalse
    Selection.InlineShapes(1).Height = 155.9
    Selection.InlineShapes(1).Width = 113.4
    Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
    Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
    Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
    Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
    Selection.InlineShapes(1).PictureFormat.CropRight = 0#
    Selection.InlineShapes(1).PictureFormat.CropTop = 0#
    Selection.InlineShapes(1).PictureFormat.CropBottom = 0#

End Sub
Private Sub åbnResultatDokument(dotnavn)
    If sideNr = 0 Then
        Set resDoc = CreateObject("Word.Application")
        resDoc.Documents.Add Template:=dotnavn
        resDoc.Visible = True 'False
    Else
Rem indsæt nye side
        With resDoc
            .Selection.EndKey Unit:=wdStory
            .Selection.InsertBreak Type:=wdPageBreak
            .Selection.InsertFile FileName:=dotnavn

Rem Fjern linieskift øverst på den indsatte side
            .ActiveDocument.Tables(sideNr + 1).Select
            .Selection.MoveUp Unit:=wdLine, Count:=1
            .Selection.Delete Unit:=wdCharacter, Count:=1
        End With
    End If
   
    sideNr = sideNr + 1
End Sub
Private Sub lukResultatDokument()
Dim tidsstempel
On Error Resume Next
Rem Slet sidste side (blank)
    With resDoc
        .Selection.EndKey Unit:=wdStory
        .Selection.Delete Unit:=wdCharacter, Count:=1
    End With

    resDoc.ActiveDocument.SaveAs skabelonSti + "Billeder_" + Format(Now, "dd-mm-yy hhmm") + ".doc"
    resDoc.Application.Quit
    Set resDoc = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim sv
    sv = MsgBox("Vil du starte? - sti til billeder m.v. skal ajourføres først", vbYesNo)
    If sv = 6 Then
        behandlingAfBilleder billedMappe
    End If
End Sub

Kanon service, tak for hjælpen 'supertekst'

tekniskdesigner - jeg kunne selv have stor nytte af billedskabelonen "supertekst" har lavet, men han har ikke filene længere. Har du dem fortsat?

Det har jeg desværre ikke...