artsjeroen
10-16-2015, 01:53 AM
I have this macro to create a CommandButton:
Private Sub Document_open()
Dim DocTest As String
On Error Resume Next
DocTest = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
DocTest = Left(DocTest, Len(DocTest) - 2)
If Not DocTest = "Subject" Then
Dim doc As Word.Document
Set doc = ActiveDocument
With doc.Content.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1").ConvertToShape.OLEFormat.Object
.AutoSize = False
.Caption = "Save & Close"
.Enabled = True
.Font.Underline = False
.Font.Size = 11
.Height = 24
.Left = 500
.Locked = False
.TakeFocusOnClick = True
.Top = 25
.Width = 72
End With
On Error Resume Next
For Each o In ActiveDocument.Shapes
If Not o.OLEFormat.Object.Name = "CommandButton1" Then
o.Delete
End If
Next
End If
If DocTest = "Subject" Then
On Error Resume Next
For Each o In ActiveDocument.Shapes
If o.OLEFormat.Object.Name = "CommandButton1" Then
o.Delete
End If
Next
End If
Dim code As String
With ActiveDocument
End With
End Sub
And I want the added commandbutton to do this:
Private Sub CommandButton1_Click()
Dim NumCopies As String
Dim YearNum As String
Dim Form As String
Dim Counter As Long
Dim oRng As Range
Dim StartNum As String
Form = InputBox("Test", "Formuliernaam", "XXXX")
If Form = "" Then Exit Sub
YearNum = Val(InputBox("Voer het jaartal in...", "Jaartal", "2015"))
If YearNum = 0 Then Exit Sub
StartNum = Val(InputBox("Voer het startnummer in...", "Start nummer", "0001"))
If StartNum = 0 Then Exit Sub
StartNum = Format(StartNum, "0000")
NumCopies = Val(InputBox("Voer het aantal af te drukken formulieren in...", "Aantal", 1))
Set oRng = ActiveDocument.Bookmarks("Number").Range
Counter = 0
If MsgBox("Weet je het zeker?" & vbNewLine & "Let op dat de juiste standaard printer is geinstalleerd." & vbNewLine & "Let op dat de printer juist is geconfigureerd." _
& vbNewLine & vbNewLine & vbNewLine & NumCopies & " formulier(en) printen?", _
vbExclamation + vbYesNo, "Alles goed ingevoerd?") = vbYes Then
While Counter < NumCopies
oRng.Text = Form + Chr(11) + YearNum + Chr(11) + StartNum
StartNum = Format(StartNum, "0000")
Options.PrintDrawingObjects = False
ActiveDocument.PrintOut Background:=False
StartNum = StartNum + 1
StartNum = Format(StartNum, "0000")
Counter = Counter + 1
ActiveDocument.Bookmarks.Add "Number", oRng
Wend
Else
Exit Sub
End If
If MsgBox("Document opslaan?", vbQuestion + vbYesNo, "Opslaan?") = vbYes Then
ActiveDocument.Save
End If
If MsgBox("Microsoft Word aflsuiten?", vbExclamation + vbYesNo, "Afsluiten?") = vbYes Then
Application.Quit
Else
Exit Sub
End If
Exit Sub
End Sub
How can I get both codes to work as one in the Normal module? (I want the macro to be available for other users)
The first code creates a commandbutton, but the CommandButton1_Click() command is then placed in the Project module.
Any help or suggestions are very welcome :)
Private Sub Document_open()
Dim DocTest As String
On Error Resume Next
DocTest = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
DocTest = Left(DocTest, Len(DocTest) - 2)
If Not DocTest = "Subject" Then
Dim doc As Word.Document
Set doc = ActiveDocument
With doc.Content.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1").ConvertToShape.OLEFormat.Object
.AutoSize = False
.Caption = "Save & Close"
.Enabled = True
.Font.Underline = False
.Font.Size = 11
.Height = 24
.Left = 500
.Locked = False
.TakeFocusOnClick = True
.Top = 25
.Width = 72
End With
On Error Resume Next
For Each o In ActiveDocument.Shapes
If Not o.OLEFormat.Object.Name = "CommandButton1" Then
o.Delete
End If
Next
End If
If DocTest = "Subject" Then
On Error Resume Next
For Each o In ActiveDocument.Shapes
If o.OLEFormat.Object.Name = "CommandButton1" Then
o.Delete
End If
Next
End If
Dim code As String
With ActiveDocument
End With
End Sub
And I want the added commandbutton to do this:
Private Sub CommandButton1_Click()
Dim NumCopies As String
Dim YearNum As String
Dim Form As String
Dim Counter As Long
Dim oRng As Range
Dim StartNum As String
Form = InputBox("Test", "Formuliernaam", "XXXX")
If Form = "" Then Exit Sub
YearNum = Val(InputBox("Voer het jaartal in...", "Jaartal", "2015"))
If YearNum = 0 Then Exit Sub
StartNum = Val(InputBox("Voer het startnummer in...", "Start nummer", "0001"))
If StartNum = 0 Then Exit Sub
StartNum = Format(StartNum, "0000")
NumCopies = Val(InputBox("Voer het aantal af te drukken formulieren in...", "Aantal", 1))
Set oRng = ActiveDocument.Bookmarks("Number").Range
Counter = 0
If MsgBox("Weet je het zeker?" & vbNewLine & "Let op dat de juiste standaard printer is geinstalleerd." & vbNewLine & "Let op dat de printer juist is geconfigureerd." _
& vbNewLine & vbNewLine & vbNewLine & NumCopies & " formulier(en) printen?", _
vbExclamation + vbYesNo, "Alles goed ingevoerd?") = vbYes Then
While Counter < NumCopies
oRng.Text = Form + Chr(11) + YearNum + Chr(11) + StartNum
StartNum = Format(StartNum, "0000")
Options.PrintDrawingObjects = False
ActiveDocument.PrintOut Background:=False
StartNum = StartNum + 1
StartNum = Format(StartNum, "0000")
Counter = Counter + 1
ActiveDocument.Bookmarks.Add "Number", oRng
Wend
Else
Exit Sub
End If
If MsgBox("Document opslaan?", vbQuestion + vbYesNo, "Opslaan?") = vbYes Then
ActiveDocument.Save
End If
If MsgBox("Microsoft Word aflsuiten?", vbExclamation + vbYesNo, "Afsluiten?") = vbYes Then
Application.Quit
Else
Exit Sub
End If
Exit Sub
End Sub
How can I get both codes to work as one in the Normal module? (I want the macro to be available for other users)
The first code creates a commandbutton, but the CommandButton1_Click() command is then placed in the Project module.
Any help or suggestions are very welcome :)