I had the MathCad 15.1, and i use the code below to save the Sheets as à Pictures using the pdf creator.
Now, I am using the PTC MathCad prime 8.0 and the code is not working. What I should do to repair it?
(The case "PTC MathCad Prime COM Automation" is activated)
------------------------------------------------------------------------------------------
'1.3.2
'look at the mathcad and pdf crator reference, look in pdf creator for only a file per page
Public MCDruckCancel As Boolean
Sub maktu()
Dim outputjob As Object
Dim MC As MathcadPrime.Automation
Dim WK As Mathcad.Worksheets
Dim WS As Mathcad.Worksheet
Set MC = New Mathcad.Application
Set WK = MC.Worksheets
TSstart = Now()
MCDruckCancel = False
Dim DocList() As String
Dim ADocList() As String
Z = 0
DocPath = ActiveDocument.Path
sDatei = Dir(DocPath & "\*.xmcd")
While sDatei <> ""
If IsNumeric(Left(sDatei, 3)) Then 'alle mit drei ziffern zuerst werden gedruckt
ReDim Preserve ADocList(Z)
ADocList(Z) = sDatei
Z = Z + 1
End If
sDatei = Dir()
Wend
Gesamtzahl_MCs = Z
If Z = 0 Then
MsgBox ("keine Mathcads da du held")
Exit Sub
Else
Load ufMCprogress
ufMCprogress.Move 10, 10
ufMCprogress.Show
ufMCprogress.ProgressBar1.Value = 1
ufMCprogress.laProgress.Caption = "0 von " & Gesamtzahl_MCs
Z = 0
docZ = 0
While Z <= UBound(ADocList) And MCDruckCancel = False
' bei nicht aktuellem oder nicht exisiteirenden bilder wird switch gesetzt
If Dir(DocPath & "\pics\" & Left(ADocList(Z), Len(ADocList(Z)) - 5) & "_p1.png") = "" Then
aktuSW = True
Else
If FileDateTime(DocPath & "\" & ADocList(Z)) > FileDateTime(DocPath & "\pics\" & Left(ADocList(Z), Len(ADocList(Z)) - 5) & "_p1.png") Then
aktuSW = True
Else
aktuSW = False
End If
End If
'Druck
If UserForm1.cbCleanMCDruck.Value = True Or aktuSW = True Then
ReDim Preserve DocList(docZ)
DocList(docZ) = ADocList(Z)
pfadmcSh = DocPath & Application.PathSeparator & DocList(docZ)
Set WS = WK.Open(pfadmcSh)
'MC.Visible = True
Call PrintToPDFCreator_Early(DocPath, Left(DocList(docZ), Len(DocList(docZ)) - 5) & "_p", outputjob)
WS.PrintAll
Call druckbeenden(outputjob)
WS.Close (mcDiscardChanges)
docZ = docZ + 1
End If
Z = Z + 1
ufMCprogress.ProgressBar1.Value = (Z / Gesamtzahl_MCs) * 100
ufMCprogress.laProgress.Caption = Z & " von " & Gesamtzahl_MCs
Wend
End If
MC.Quit
Unload ufMCprogress
If docZ = 0 Then
MsgBox ("alle MC's aktuell")
Exit Sub
Else
For i = 0 To UBound(DocList)
DocListStr = DocListStr & DocList(i) & vbNewLine
Next
If MCDruckCancel = True Then
DocListStr = DocListStr & vbNewLine & vbNewLine & "Abruch durch user" & vbNewLine
End If
TSende = Now()
MsgBox (DocListStr & vbNewLine & "erfolgreich aktualsiert in " & Format(TSende - TSstart, "hh:mm:ss"))
End If
End Sub
Sub PrintToPDFCreator_Early(OutputPath, sOutputName, ByRef outputjob)
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to Output file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for early bind, set reference to PDFCreator
Dim sOutputPath As String
Dim lOutputType As Long
'0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
lOutputType = 1
sOutputPath = OutputPath & Application.PathSeparator & "pics" & Application.PathSeparator
Set outputjob = New PDFCreator.clsPDFCreator
'Set correct filename extension
Select Case lOutputType
Case Is = 0
sOutputName = sOutputName & ".pdf"
Case Is = 1
sOutputName = sOutputName & ".png"
Case Is = 2
sOutputName = sOutputName & ".jpg"
Case Is = 3
sOutputName = sOutputName & ".bmp"
Case Is = 4
sOutputName = sOutputName & ".pcx"
Case Is = 5
sOutputName = sOutputName & ".tif"
Case Is = 6
sOutputName = sOutputName & ".ps"
Case Is = 7
sOutputName = sOutputName & ".eps"
Case Is = 8
sOutputName = sOutputName & ".txt"
End Select
'Set job defaults
With outputjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("BitmpaResolution") = 300
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sOutputPath
.cOption("AutosaveFilename") = sOutputName
.cOption("AutosaveFormat") = lOutputType
.cClearCache
End With
End Sub
Sub druckbeenden(ByRef outputjob)
'Wait until the print job has entered the print queue
Do Until outputjob.cCountOfPrintjobs > 0
DoEvents
Loop
outputjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until outputjob.cCountOfPrintjobs = 0
DoEvents
Loop
outputjob.cClose
Set outputjob = Nothing
End Sub
