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

FAQFAQ  SzukajSzukaj  UżytkownicyUżytkownicy  GrupyGrupy
RejestracjaRejestracja  ZalogujZaloguj  DownloadDownload

Poprzedni temat «» Następny temat
Makro Automatyczne zapisywanie do starszej wersji Corela
Autor Wiadomość
Printgrav
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 5 Styczeń 2022, 20:59   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 
Doradca
Grafik?


Wersja CorelDRAW: 2019
Pomógł: 14 razy
Dołączył: 29 Sty 2011
Posty: 113
Skąd: Czmoń
Wysłany: 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
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 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
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 15 Styczeń 2022, 16:21   

Z wielkością pliku juz sobie poradziłem, zmieniłem: .EmbedICCProfile = false
 
 
Martin Nez 
Doradca
Grafik?


Wersja CorelDRAW: 2019
Pomógł: 14 razy
Dołączył: 29 Sty 2011
Posty: 113
Skąd: Czmoń
Wysłany: 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
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 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 
Doradca
Grafik?


Wersja CorelDRAW: 2019
Pomógł: 14 razy
Dołączył: 29 Sty 2011
Posty: 113
Skąd: Czmoń
Wysłany: 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
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 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
Początkujący


Dołączył: 05 Sty 2022
Posty: 6
Skąd: Kalisz
Wysłany: 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ę
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Nowe zasady dotyczące cookies. Wykorzystujemy pliki cookies, aby nasz serwis lepiej spełniał Państwa oczekiwania. Można zablokować zapisywanie cookies, zmieniając ustawienia przeglądarki.
         
Strona wygenerowana w 0.1 sekundy. Zapytań do SQL: 13