Thema: Flaggen nach dem Zufallsprinzip vertauschen

StandardModule: Modul1

Sub Importieren()
   Dim iCounter As Integer
   With Application.FileSearch
      .NewSearch
      .LookIn = "c:\bilder\flaggen"
      .Filename = "*.jpg"
      .Execute
      For iCounter = 1 To .FoundFiles.Count
         ActiveSheet.Pictures.Insert .FoundFiles(iCounter)
      Next iCounter
   End With
End Sub

Sub Start()
   Dim rng As Range, rngAll As Range
   Dim iRandomize As Integer
   Set rngAll = Range("A1:B2")
   Randomize
   For Each rng In rngAll
      iRandomize = Int((16 * Rnd) + 1)
      Do Until WorksheetFunction.CountIf(rngAll, iRandomize) = 0
         iRandomize = Int((16 * Rnd) + 1)
      Loop
      rng.Value = iRandomize
   Next rng
   Call MovePictures
End Sub

Private Sub MovePictures()
   Dim pct As Picture
   Dim rng As Range, rngAll As Range
   Set rngAll = Range("A1:B2")
   For Each pct In ActiveSheet.Pictures
      pct.Left = Range("IV1").Left
      pct.Top = Range("IV1").Top
   Next pct
   For Each rng In rngAll.Cells
      With ActiveSheet.Pictures(rng.Value)
         .Left = rng.Left
         .Top = rng.Top
      End With
   Next rng
End Sub

Beiträge aus dem Excel-Forum zu den Themen Grafik und Einsetzen