Как скопировать кнопку на новый лист с макросом

У меня есть форма в VBA, в которой есть кнопка для создания нового листа в рабочей книге.

На этом новом листе мне нужно 4 кнопки, чтобы их код уже был на месте.

Когда я нажимаю кнопку "Создать новый лист", у меня появляется следующий код для обновления новых кнопок на новом листе:

'Update quantity button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=150, Top:=20, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(1).Object.Caption = "Update Quantity"

'update quantity code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    LineNum = .CountOfLines + 1
    .InsertLines LineNum, _
        "Private Sub CommandButton1_Click()" & vbLf & _
        "Dim ComponentAmt As Double" & vbLf & _
        "ComponentNum = Application.InputBox(""Please provide a component number"", ""Component Number"", Type:=1)" & vbLf & _
        "ComponentAmt = Application.InputBox(""Quantity received of the component"", ""Quantity Received"", Type:=1)" & vbLf & _
        "Set found = Range(""A:A"").Find(what:=ComponentNum, LookIn:=xlValues, LookAt:=xlWhole)" & vbLf & _
        "If found Is Nothing Then" & vbLf & _
        "MsgBox ""Your component number was not found" & vbLf & _
        "Else" & vbLf & _
        "found.Offset(0, 2).Value = found.Offset(0,2).Value + ComponentAmt" & vbLf & _
        "End If" & vbLf & _
        "End Sub"
End With

'Archive button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=400, Top:=200, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(2).Object.Caption = "1. Export PO"

'Archive Code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    LineNum2 = .CountOfLines + 1
    .InsertLines LineNum2, _
        "Private Sub CommandButton2_Click()" & vbLf & _
            "ActiveSheet.Copy" & vbLf & _
            "With ActiveSheet.UsedRange" & vbLf & _
                ".Copy" & vbLf & _
                ".PasteSpecial xlValue" & vbLf & _
                ".PasteSpecial xlFormats" & vbLf & _
            "End With" & vbLf & _
            "Application.CutCopyMode = False" & vbLf & _
            "ActiveWorkbook.SaveAs ""Full Path/""" & vbLf & _
        "End Sub"
End With

'Hide button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=400, Top:=250, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(3).Object.Caption = "2. Done"

'hide button Code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    LineNum4 = .CountOfLines + 1
    .InsertLines LineNum4, _
        "Private Sub CommandButton3_Click()" & vbLf & _
            "ActiveSheet.Select" & vbLf & _
            "ActiveWindow.SelectedSheets.Visible = False" & vbLf & _
        "End Sub"
End With

'View price button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=200, Top:=20, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(4).Object.Caption = "View Price"

'View price code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    LineNum4 = .CountOfLines + 1
    .InsertLines LineNum4, _
        "Private Sub CommandButton4_Click()" & vbLf & _
            "Range(""I10"").Select" & vbLf & _
            "ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-8]C[-7],KitList!C[-8]:C[11],17,FALSE)""" & vbLf & _
            "Range(""J10"").Select" & vbLf & _
            "ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-8]C[-8],KitList!C[-9]:C[10],18,FALSE)""" & vbLf & _
            "Range(""I11"").Select" & vbLf & _
            "ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-9]C[-7],KitList!C[-8]:C[11],19,FALSE)""" & vbLf & _
            "Range(""J11"").Select" & vbLf & _
            "ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-9]C[-8],KitList!C[-9]:C[10],20,FALSE)""" & vbLf & _
        "End Sub"
End With

Затем кнопки отображаются на новом листе, но когда я нажимаю на них, ничего не происходит.

Кроме того, при нажатии на лист в VBA у меня есть следующий код, который должен быть для кнопок.

Private Sub CommandButton1_Click()
'update quantity
Dim ComponentAmt As Double
ComponentNum = Application.InputBox("Please provide a component number", "Component Number", Type:=1)
ComponentAmt = Application.InputBox("Quantity received of the component", "Quantity Received", Type:=1)
Set found = Range("A:A").Find(what:=ComponentNum, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
MsgBox "Your component number was not found"
Else
found.Offset(0, 2).Value = found.Offset(0, 2).Value + ComponentAmt
End If
End Sub
Private Sub CommandButton2_Click()
'export PO
ActiveSheet.Copy
With ActiveSheet.UsedRange
.Copy
.PasteSpecial xlValue
.PasteSpecial xlFormats
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs "Full Path/"
End Sub
Private Sub CommandButton3_Click()
'hides the PO in the document
ActiveSheet.Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
Private Sub CommandButton4_Click()
'view price
Range("I10").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-8]C[-7],KitList!C[-8]:C[11],17,FALSE)"
Range("J10").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-8]C[-8],KitList!C[-9]:C[10],18,FALSE)"
Range("I11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-9]C[-7],KitList!C[-8]:C[11],19,FALSE)"
Range("J11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-9]C[-8],KitList!C[-9]:C[10],20,FALSE)"
End Sub

Должен ли я сделать код для каждой кнопки в качестве подпрограммы, чтобы кнопки вызывали подпрограмму?

Если я создам более одного нового листа, названия кнопок будут меняться?

0 ответов

Другие вопросы по тегам