将按钮提交到其他工作簿

时间:2018-02-19 12:16:18

标签: excel vba excel-vba export

我正在创建一个新的Excel模板,管理员可以在其中添加信息,以便我们可以根据他们的模板进行报价。这意味着,如果他们点击提交按钮,该按钮取决于值段gos到正确的excel文件(跟进列表),并且客户名称,客户ID和一般信息放在后续列表中。

这是我迄今为止的代码,只有我需要的提交按钮。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B7")) Is Nothing Then
    If Range("B7") <> "Server & Storage" And Range("B7") <> "Power" And Range("B7") <> "Networking" And Range("B7") <> "Software" And Range("B7") <> "Printing" Then
        MsgBox "Selecteer een value segment!"
    End If
Else
    Exit Sub
End If

End Sub
'E-mail knop
 Private Sub CommandButton1_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim srtEmail As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi Team," & vbNewLine & vbNewLine & _
          "Dit is een nieuwe request voor " & Range("B8")

If Range("B7") = "Server & Storage" Then
    srtEmail = "hardware@bechtle.be"
Else
    If Range("B7") = "Power" Then
        srtEmail = "hardware@bechtle.be"
    Else
        If Range("B7") = "Networking" Then
         srtEmail = "networking@bechtle.be"
         Else
            If Range("B7") = "Software" Then
             srtEmail = "software@bechtle.be"
              Else
                  If Range("B7") = "Printing" Then
                    srtEmail = "kristof.neubauer@bechtle.com"
                  Else
                    MsgBox "Geen value segment geselecteerd!"
                End If
            End If
        End If
    End If
End If
              On Error Resume Next
With xOutMail

    .To = srtEmail
    .CC = "berty.vaneijgen@bechtle.com"
    .BCC = ""
    .Subject = "Value Request voor " & Range("B9") & Range("B8")
    .Body = xMailBody

If Range("B7") <> "" Then
    .Display   'or use .Send
End If
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
'Reset knop
 Private Sub CommandButton2_Click()
  Sheets("VRT").Range("B7:B33") = ""
  MsgBox "Velden zijn gewist!"

  End Sub
  'Save as knop
 Private Sub CommandButton3_Click()
  Dim nom As String
  nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " " & Range("B8")
   ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom & ".xlsm"
   rep = MsgBox("Je bestand is opgeslagen! ", vbYes + vbInformation, "Copy  of spreadsheet")

  'MsgBox(You database has been saved  : " & Name, vbYes +         vbInformation, "Copy of spreadsheet")
 End Sub
  'print
  Private Sub Workbook_BeforePrint(Cancel As Boolean)
   Cancel = (ActiveSheet.Name = "VRT")
  If Cancel = True Then MsgBox "Gebruik de print knop."

 End Sub
    'print knop
  Private Sub CommandButton4_Click()
 On Error Resume Next
   Application.EnableEvents = False
    With ActiveWorkbook.Sheets("VRT")
            .Range("A1:F33").PrintOut
    End With
   Application.EnableEvents = True
   On Error GoTo 0
    End Sub

 Private Sub CommandButton5_Click()

 End Sub

2 个答案:

答案 0 :(得分:0)

enter image description here

  • 然后确保按钮的名称为CommandButton1,以便与您的代码兼容。这是重命名按钮名称的位置: enter image description here

答案 1 :(得分:0)

由于您提到您拥有代码,并且只需要添加按钮,因此这些步骤可能就是您需要遵循的步骤。

- 从“开发者”中添加一个按钮&#39;选项卡使用插入组

- 右键单击​​按钮以指定宏..&#39;。您将看到一个潜艇的列表  存在于工作簿中以供选择。

- 代码使用类似的东西

v1