оптимизировать код VBA макроса в coreldraw

    Sub Resample()
        Dim OrigSelection As ShapeRange
        Set OrigSelection = ActiveSelectionRange
        On Error Resume Next
        OrigSelection.OrderToBack
        OrigSelection(240).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(1).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(2).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(3).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(4).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(5).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(6).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(7).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(8).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(9).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(10).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(11).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(12).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(13).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(14).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(15).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(16).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(17).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(18).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(19).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(20).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(21).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(22).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(23).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(24).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(25).Bitmap.Resample 1936, 1290, True, 400#, 400#
        OrigSelection(26).Bitmap.Resample 1936, 1290, True, 400#, 400#
end sub

нужно записать выбор всех объектов одной строчкой, вроде OrigSelection(1-26).Bitmap.Resample 1936, 1290, True, 400#, 400# а ещё лучше (1 - бесконечность)


Ответы (1 шт):

Автор решения: Qwertiy

Как-то так:

Sub Resample()
  Dim OrigSelection As ShapeRange
  Set OrigSelection = ActiveSelectionRange

  OrigSelection.OrderToBack

  On Error Resume Next
    For Q = 1 To 240
      OrigSelection(Q).Bitmap.Resample 1936, 1290, True, 400#, 400#
      If Err Then Err.Clear
    Next Q
  On Error GoTo 0
End Sub
→ Ссылка