View Single Post
  #3  
Old 18-09-2012, 06:30
IngoInternet IngoInternet is offline
Junior Member
 
Join Date: Sep 2012
Posts: 2
Default 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.
Reply With Quote