Макрос MS Office Excel: удаление цветных строк

Есть табличка, большая часть строк с черным текстом, часть строк выделена красным, синим, зеленым цветом.






Макрос удаляет цветные строки:


Sub removeNoBlackText() 

 i = ActiveSheet.UsedRange.Rows.Count 

 For c = i To 1 Step -1 

 If Cells(c, 1).Font.Color <> Black Then Rows(c).Delete 

 Next 

End Sub

Макрос MS Office: замена картинок именами файлов

Этот код заменяет все изображения (картинки, диаграммы, смарты) именами файлов:

Sub Picture_del()

Dim oInlineShape As InlineShape

Dim i As Integer

i = 1

Selection.HomeKey Unit:=wdStory

For Each oInlineShape In ActiveDocument.InlineShapes

oInlineShape.Select

Selection.Delete Unit:=wdCharacter, Count:=1

Selection.TypeText Text:="[img]img" & i & ".tif[/img]"

i = i + 1

Next

End Sub

Этот код заменяет только картинки именами файлов

Sub del_pick()

  Dim ii, rng, nn

  nn = 0 'число собс-но картинок

  With ActiveDocument.InlineShapes

   For ii = 1 To .Count Step 1  'сначала считаем картинки

      If .Item(ii).Type = 3 Then 'Это картинка

        nn = nn + 1 'Увеличим счетчик картинок

      End If

   Next ii

   If nn > 0 Then ' Если есть что заменять

     For ii = .Count To 1 Step -1 'теперь пойдём от хвоста

       If .Item(ii).Type = 3 Then 'Это картинка?

         Set rng = .Item(ii).Range.Duplicate ' запомним место

         .Item(ii).Delete 'удалим картинку

         rng.Text = "[img]image" & nn & ".tif[/img]" 'Впишем название

         nn = nn - 1 'Уменьшим счётчик картинок

       End If

     Next ii

   End If

  End With

End Sub

CorelPhotoPaint - обрезка изображения по объекту

Sub TransDel()

Dim doc As Document

Dim lr As Layer

Set doc = ActiveDocument

Set lr = ActiveDocument.ActiveLayer

lr.CreateMask

doc.CropToMask

doc.Mask.Delete

doc.Save

End Sub

Быстрый экспорт в JPG

Решил сделать макрос для CorelDraw X3, который осуществляет быстрый экспорт в JPG.

Форма выглядит так:

Код макроса такой:

Private Sub CommandButton1_Click()

If UserForm10.TextBox1.Text = "" Then MsgBox "Не ввели имя файла": Exit Sub


Dim opt As New StructExportOptions
Dim expJPGfiltr As ExportFilter
Dim exp_jpg As String
Dim pg As Page


If UserForm10.CheckBox1.Value = True Then opt.ImageType = cdrCMYKColorImage Else opt.ImageType = cdrRGBColorImage
opt.ResolutionX = UserForm10.TextBox2
opt.ResolutionY = UserForm10.TextBox2
opt.Dithered = True
opt.AntiAliasingType = cdrSupersampling
opt.UseColorProfile = True

If UserForm10.CheckBox2.Value = True Then
         'файлы сохранятся там же, где лежит исходник
        exp_jpg = ActiveDocument.FilePath + UserForm10.TextBox1.Text
    Else
        'файлы сохранятся в фиксированную папку
exp_jpg = "C:\Temp" + UserForm10.TextBox1.Text
End If

'по умолчанию экспортирует только текущую страницу
'но может экспортировать и все страницы
If UserForm10.CheckBox3 = True Then

For Each pg In ActiveDocument.Pages
pg.Activate
Set expJPGfiltr = ActiveDocument.ExportBitmap(exp_jpg + Str(pg.Index) + ".jpg", cdrJPEG, cdrCurrentPage, _
    opt.ImageType, , , opt.ResolutionX, opt.ResolutionY, opt.AntiAliasingType, , , opt.UseColorProfile)
    With expJPGfiltr
        .Progressive = False
        .Optimized = True
        .Compression = 10
        .Smoothing = 5
        .Finish
    End With
Next pg
  
    Else   

Set expJPGfiltr = ActiveDocument.ExportBitmap(exp_jpg + ".jpg", cdrJPEG, cdrCurrentPage, _
    opt.ImageType, , , opt.ResolutionX, opt.ResolutionY, opt.AntiAliasingType, , , opt.UseColorProfile)
    With expJPGfiltr
        .Progressive = False
        .Optimized = True
        .Compression = 10
        .Smoothing = 5
        .Finish
    End With
  
    End If

Unload UserForm10

End Sub

Большое спасибо за помощь в создании макроса пользователю splxgf с форума rudtp.ru

Качественная тень в CorelDraw

Написал небольшой макрос, который делает качественную тень в CorelDraw. Ведь многие сталкивались с тем, что CorelDraw создает очень плохие тени - они искажаются на разных подложках, разваливаются на печати, да и не совсем понятно как работают...
Конечно мой скрипт имеет значительно меньше возможностей, у меня тень представляет собой растровый объект, после создания которого его изменение невозможно, разве что удаление и повторное создание. Тень у меня может быть либо белая, либо черная.

Макрос для построения случайных фигур в CorelDRAW написан на VBA

Visual Basic for Applications (VBA, Visual Basic для приложений) — немного упрощённая реализация языка программирования Visual Basic, встроенная в CorelDRAW и некоторые другие программы.  VBA является интерпретируемым языком. Как и следует из его названия, VBA близок к Visual Basic. VBA, будучи языком, построенным на COM, позволяет использовать все доступные в операционной системе COM объекты и компоненты ActiveX.
С помощь VBA можно значительно ускорить выполнение некоторых операций в CorelDRAW. 
Отмечу, что я не являюсь профессиональным программистом, скорее я оптимизатор рутинных процессов. Поэтому если мой код покажется вам не оптимальным, прошу камнями не кидаться
В данном уроке, показывается как построить множество случайных фигур (эллипсов, прямоугольников, звезд) со случайными заливками и обводками, имеющих случайную прозрачность.

Создание визитки средствами VBA

В этом уроке я попробую объяснить, как с помощью встроенного в CorelDRAW языка программирования Visual Basiс for Application (VBA), быстро создать серию однотипных визиток (например для директора, бухгалтера, менеджеров). Главной целью буду считать не дизайнерские изыски (это отведу на творчество читателя - для самостоятельного выполнения), а принципы работы с редактором VBA и написание кода (причем я не считаю себя сколько-нибудь программистом, скорее всего "оптимизатором рутинных процессов"). Программы написанные на VBA для CorelDRAW называются макросами (как и в MS Office).