Mehrere Bilder per VBA in Tabelle nebeneinander

Sub nebeneinander() Dim i%, j As Integer Dim objFile As Object Dim ObjektDLG As Dialog Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) ObjektDLG.Show Application.ScreenUpdating = False i = 1 j = 1 For Each objFile In ActiveSheet.Shapes objFile.Width = 125 objFile.Left = Cells(1, i).Left objFile.Top = Cells(j, 1).Top i = (i + 3) Next Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub nebeneinander() Dim objFile As Object Dim ObjektDLG As Dialog Dim T As Double, L As Double T = ActiveCell.Top L = ActiveCell.Left Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) ObjektDLG.Show Application.ScreenUpdating = False For Each objFile In ActiveSheet.Shapes objFile.Top = T objFile.Left = L L = L + objFile.Width Next Application.ScreenUpdating = True End Sub

Sub nebeneinander() Dim objFile As Object Dim ObjektDLG As Dialog Dim T As Double, L As Double T = ActiveCell.Top L = ActiveCell.Left Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture) ObjektDLG.Show Application.ScreenUpdating = True For Each objFile In ActiveSheet.Shapes objFile.Width = 125 objFile.Top = T objFile.Left = L L = L + objFile.Width + 30 Next Application.ScreenUpdating = False End Sub

naja, wenn du dich mit VBA nicht auskennst und Codes verwendest, die du irgenwo gefunden hast, dann ist das ein bisschen wie fahren ohne Führerschein mit "geliehenen" Fahrzeugen.
Da stellt sich immer die Frage, ob man sowas unterstützen sollte oder nicht.
im Prinzip fügt dein Code die Bilder ein und sortiert dann alle Bilder auf dem Blatt.
du müsstest dann ggf die Bilder nach dem Verschieben kennzeichnen und vor dem Verschieben prüfen, ob die Bilder bereits ein Kennzeichen haben.
Teste mal das:

Sub nebeneinander()
Dim objFile As Object
Dim ObjektDLG As Dialog
Dim T As Double, L As Double
T = ActiveCell.Top
L = ActiveCell.Left
Set ObjektDLG = Application.Dialogs(xlDialogInsertPicture)
ObjektDLG.Show
Application.ScreenUpdating = True
For Each objFile In ActiveSheet.Shapes
if left(objFile.Name, 3)  "xxx" then
objFile.Width = 125
objFile.Top = T
objFile.Left = L
objFile.Name = "xxx" & objFile.Name
L = L + objFile.Width + 30
end if
Next
Application.ScreenUpdating = False
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Mehrere Bilder per VBA in Tabelle nebeneinander

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Bilder per VBA in Tabelle nebeneinander

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread