OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   General (http://forum.oberonplace.com/forumdisplay.php?f=26)
-   -   Problem with printing through a macro (http://forum.oberonplace.com/showthread.php?t=8367)

IngoInternet 08-09-2012 06:15

Problem with printing through a macro
 
hello,
i hope i can find help in your forum.
i am working with corel draw x6 and going to print some shapes by pressing a button on a vba form.
i created the vba code by recording it by the macro recorder.
if i press the button on blank page, the print information window comes up and i can change the printer, the page layout ...
if i copy some files from another layer to the print layer, i created, corel draw x6 will hang up.

i created a button that activates a layer (viewable,brintable,editable) wich was deactivated. selects the shapes on the layer. deactivates the layer again and activates another layerand paste's the shapes on it.
now the print macro is going to run and taataaaa, corel draw x6 is going to hang up.

i asked the corel draw support but they told me, that is not a problem from the software, its a problem of the macro.

i recorded the macro with a tool from the software (corel draw x6) and i run the macro with a tool from the software.

The macro i call is : ActiveDocument.PrintSettings.ShowDialog

thank you for your time

IngoInternet

21 is only the half of the answer to life, the universe and everything

shelbym 09-09-2012 17:52

Printing
 
Can you post your code, and the exact steps that you are wanting it todo. I am sure we can solve this for you.

-Shelby

IngoInternet 18-09-2012 06:30

Printing
 
Hello Shelbym,

thank you for Your answer, here ist the complete Macro code:



Dim doc As Documents

Private Sub ChkBox1_Click()
Ausgrauen
End Sub

Private Sub ChkBox2_Click()
Ausgrauen
End Sub


Private Sub CmdBut_Abbruch_Click()

ActiveLayer.Shapes.All.Delete
UserForm1.Hide
'ActiveDocument.Save = False
'MsgBox (ActiveDocument.Name)

'ActiveDocument.Close


End Sub

Private Sub CmdBut_Beenden_Click()

On Error Resume Next

UserForm1.Hide
'ActiveDocument.Activate
'ActiveDocument.Save
'MsgBox (ActiveDocument.Name)

ActiveDocument.Close

End Sub

Private Sub CmdBut_Delete_Click()

ActiveLayer.Shapes.All.Delete

End Sub

Private Sub CmdBut_OK_Click()

OB = "Ordner Breit"
OM = "Ordner Mittel"
OS = "Ordner Schmal"

ActivePage.Layers("Druckrahmen").Activate

If OptBut_Breit.Value = True Then

COPY_Master (OB)

ElseIf OptBut_Mittel.Value = True Then

COPY_Master (OM)

ElseIf OptBut_Schmal.Value = True Then

COPY_Master (OS)

End If

ThisDocument.Activate

End Sub

Function COPY_Master(OrdnerTyp)

ActiveDocument.MasterPage.Layers(OrdnerTyp).Editable = True
ActiveDocument.MasterPage.Layers(OrdnerTyp).Visible = True
ActiveDocument.MasterPage.Layers(OrdnerTyp).Printable = True

ActiveDocument.CreateSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(9)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(8)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(7)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(6)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(5)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(4)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(3)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(2)
ActiveDocument.AddToSelection ActiveDocument.MasterPage.Layers(OrdnerTyp).Shapes(1)

ActiveSelection.Copy

ActiveDocument.MasterPage.Layers(OrdnerTyp).Editable = False
ActiveDocument.MasterPage.Layers(OrdnerTyp).Visible = False
ActiveDocument.MasterPage.Layers(OrdnerTyp).Printable = False

ActiveLayer.Paste

ActiveSelection.Shapes("TxtFld-Zeile1").Text.Story = TxtBox_Zeile1.Value

ActiveSelection.Shapes("TxtFld-Zeile2").Text.Story = TxtBox_Zeile2.Value

ActiveSelection.Shapes("TxtFld-Zeile3").Text.Story = "Projekt Nr.: " + TxtBox_Zeile3.Value

ActiveSelection.Shapes("TxtFld-Zeile4").Text.Story = TxtBox_Zeile4.Value

ActiveSelection.Shapes("TxtFld-Zeile5").Text.Story = TextZerlegung(TxtBox_Zeile5.Value)

ActiveSelection.Shapes("TxtFld-Zeile6").Text.Story = TxtBox_Zeile6.Value

If OptBut_Rahmen = True Then ActiveSelection.Shapes("Schnittmarken").Delete

If OptBut_Schnittmarke = True Then ActiveSelection.Shapes("Rahmen").Delete

If OptBut_SchnittRahmen = True Then
ActiveSelection.Shapes("Rahmen").Delete
ActiveSelection.Shapes("Schnittmarken").Delete
End If

End Function

Private Sub CmdBut_Print_Click()

If ActiveLayer.SelectableShapes.Count = 0 Then

MsgBox ("kein Ordnerr├╝cken zum Drucken gefunden!")

Else


Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
With ActiveDocument.PrintSettings
End With

End If

End Sub

Function TextZerlegung(Text)

Platz = InStr(1, Text, "+", 1)
If Platz < 1 Then
Exit Function
Else
Laenge = Len(Text)

vorher = Left(Text, Platz - 2)
Nachher = Right(Text, Laenge - Platz - 1)
End If

TextZerlegung = vorher + Chr(13) + "+" + Chr(13) + Nachher

End Function

Function Ausgrauen()
If UserForm1.ChkBox1.Value = True Then
UserForm1.TxtBox_Zeile1.BackColor = &H8000000F
UserForm1.TxtBox_Zeile1.Locked = True
Else
UserForm1.TxtBox_Zeile1.BackColor = &H80000005
UserForm1.TxtBox_Zeile1.Locked = False
End If

If UserForm1.ChkBox2.Value = True Then
UserForm1.TxtBox_Zeile5.BackColor = &H8000000F
UserForm1.TxtBox_Zeile5.Locked = True
Else
UserForm1.TxtBox_Zeile5.BackColor = &H80000005
UserForm1.TxtBox_Zeile5.Locked = False
End If
End Function

Private Sub Frame2_Click()

Ausgrauen

End Sub

Private Sub UserForm_Initialize()

Ausgrauen

End Sub

'Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'
' Ausgrauen
'
'End Sub




Hope You can help me.

shelbym 02-10-2012 01:04

Print
 
You stated that in your code you call: ActiveDocument.PrintSettings.ShowDialog

But I do not see this anywhere in your code. The only reference to Printing is: With ActiveDocument.PrintSettings
End With

And this by itself isn't going to do anything.

-Shelby


All times are GMT -5. The time now is 17:45.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright ┬ę 2011, Oberonplace.com