16. oktober 2007 - 09:06Der er
7 kommentarer og 1 løsning
billed macro i word
Hej eksperter
En eller anden som kan forklare mig eller lave en macro til mig som sætter en række billeder ind fra en mappe, I to rækker og under billedet skal der stå billedets navn...
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
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
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
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.