оптимизировать код 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