Zobacz temat - Makro Automatyczne zapisywanie do starszej wersji Corela

Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych

Makra - Makro Automatyczne zapisywanie do starszej wersji Corela

Printgrav - 5 Styczeń 2022, 20:59
Temat postu: Makro Automatyczne zapisywanie do starszej wersji Corela

Witam, proszę o pomoc przy stworzeniu makro, używam kodu poniżej, chodzi żeby dodać linijkę do kodu żeby nie nadpisywał projektu tylko tworzył nowy . Naciskam dany przycisk i zapisuje mi nowy projekt z corela 2020 do x4 z dowolnie wpisana nazwą. Przy nowym projekcie kod nie działa a przy otwartym nadpisuje. Proszę o pomoc
kod:
Sub ZapiszDoX4()
Dim Nazwa As String
Dim Katalog As String
Nazwa = ActiveDocument.FileName
Katalog = ActiveDocument.FilePath

Dim Zapisz As StructSaveAsOptions
Set Zapisz = CreateStructSaveAsOptions
With Zapisz
.Filter = cdrCDR
.Version = cdrVersion15
.EmbedVBAProject = True
.IncludeCMXData = False
.Range = cdrAllPages
.EmbedICCProfile = True
End With

ActiveDocument.SaveAs Katalog + "" + Nazwa, Zapisz
End Sub

Martin Nez - 10 Styczeń 2022, 10:05

Witam,
ja zrobiłbym to tak:

Kod:

Sub Printgrav()
Dim Nazwa As String
Dim Katalog As String
If ActiveDocument.FileName <> "" Then
Nazwa = InputBox("Podaj nazwe pliku:", "Nazwa", ActiveDocument.FileName)
Katalog = ActiveDocument.FilePath
Else
Nazwa = InputBox("Podaj nazwe pliku:", "Nazwa", "Bez tytulu.cdr")
Katalog = Environ("homedrive") & Environ("homepath") & "\Desktop\"
End If

Dim Zapisz As StructSaveAsOptions
Set Zapisz = CreateStructSaveAsOptions
With Zapisz
.Filter = cdrCDR
.Version = cdrVersion15
.EmbedVBAProject = True
.IncludeCMXData = False
.Range = cdrAllPages
.EmbedICCProfile = True
End With

ActiveDocument.SaveAs Katalog + "" + Nazwa, Zapisz
End Sub

Pozdr,
MN

Printgrav - 15 Styczeń 2022, 15:13

Dzięki za kodzik, bardzo pomocny. Zastanawiam się tylko czemu zmienia się drastycznie rozmiar np: projekt ma 257kb, po zapisie normalnie do wersji 15 rozmiar prawie bez zmian, po zapisie przez kod rozmiar zmienia się na 1,57MB. Co powoduje taką zmianę?
W kodzie brakuje mi takiej opcji jak:
-zapis do wskazanego miejsca, nie z automatu na pulpit
-automatyczny zapis cdr ( teraz jak zmaże koncówkę przy wpisywaniu nazwy plik sie nie zapisze)
Jest możliwa taka opcja?

Printgrav - 15 Styczeń 2022, 16:21

Z wielkością pliku juz sobie poradziłem, zmieniłem: .EmbedICCProfile = false

Martin Nez - 19 Styczeń 2022, 17:05

To może spróbuj innego podejścia:

Kod:

Sub Printgrav()
Dim Nazwa As String
Dim Zapisz As StructSaveAsOptions
Set Zapisz = CreateStructSaveAsOptions
With Zapisz
.Filter = cdrCDR
.Version = cdrVersion15
.EmbedVBAProject = True
.IncludeCMXData = False
.Range = cdrAllPages
.EmbedICCProfile = False
End With

Nazwa = CorelScriptTools.GetFileBox("Pliki CorelDRAW (*.cdr)|*.cdr", "Zapisz jako...", 1, ActiveDocument.FileName, , ActiveDocument.FilePath)
If Nazwa <> "" Then ActiveDocument.SaveAs Nazwa, Zapisz
End Sub

Pozdr,
MN

Printgrav - 20 Styczeń 2022, 20:45

Dziękuje bardzo właśnie o to mi chodziło, bardzo ułatwi mi to pracę, bardzo mi pomogłeś.
Jest jeszcze możliwe makro do exportu do BMP ale o określonych parametrach, chodzi mi o podpięcie pod przycisk:
Eksport-BMP-rozmiar szer.100%, wysokość 100%-rozdzielczość 500dpi- tryb kolorów skala szarości (8-bit)- opcje wygładzenie

Pozdrawiam i jeszcze raz dzieki

Martin Nez - 21 Styczeń 2022, 17:08

Tak na szybko...

Kod:

Sub Printgrav2()
Dim Nazwa As String
Nazwa = CorelScriptTools.GetFileBox("Bitmapa (*.bmp)|*.bmp", "Eksportuj jako...", 1, ActiveDocument.FileName, , ActiveDocument.FilePath)
If Right(Nazwa, 3) = "cdr" Then Nazwa = Left(Nazwa, Len(Nazwa) - 3) & "bmp"
Dim Rozdzielczosc As Long
Rozdzielczosc = 500
Dim ExpFltr As ExportFilter
Set ExpFltr = ActiveDocument.ExportBitmap(Nazwa, cdrBMP, cdrAllPages, cdrGrayscaleImage, , , Rozdzielczosc, Rozdzielczosc, cdrNormalAntiAliasing, False, False, False)
ExpFltr.Finish
End Sub

Pozdr,
MN

Printgrav - 23 Styczeń 2022, 18:44

Dziękuję o to chodziło. Jest jednak różnica przy normalnym eksporcie a tym z kodu. Po kodzie rozjaśnia trochę zdjęcie, nie mam pojęcia jaki parametr odpowiada za taką zmianę.
Doszedłem że w tej chwili zapisuje jako: Paleta (8-bitowa) a potrzeba jako Skala szarości (8-bitowa)
Po kilku testach ten sam efekt daje: Paleta (8-bit)- skala szarości (wtedy się zmienia na jaśniejsze, efekt jak po kodzie)
Paleta ( 8-bit)- Paleta Adaptacyjna ( daje dobry efekt ten sam co Skala Szarości 8-bit, czyli nie zmienia oryginalnego zdjęcia)

Printgrav - 24 Styczeń 2022, 14:46

Do szczęścia potrzebne mi ostatnie makro:
Zapis do: PLT ( Plik plotera HGPL ) - Strona: rozmiar ISO A4, Pisak: Black- Zaawansowane: wypełnienie brak, usuń ukryte linie, Rozdzielczość krzywej: 0,0 milimetry

Mam taki kod ale potrzeba modyfikacji i zapis żeby był tak jak poprzednio pan robił do wskazanego miejsca )

Sub ExportToWinLase()
' Saves file as .plt
Dim savetopath As String
Dim expopt As StructExportOptions
'Dim yn As String

Set expopt = CreateStructExportOptions
expopt.UseColorProfile = False

Dim expflt As ExportFilter

Set expflt = ActiveDocument.ExportEx("c:\test.plt", cdrHPGL, cdrAllPages, expopt)
expflt.ShowDialog
expflt.Finish

End Sub

Dziękuję