基于表格按钮行位置的相对单元格引用

时间:2018-04-06 17:38:20

标签: vba excel-vba outlook-vba excel

我创建了一个VBA程序,它自动为N列中的给定范围插入表单控件按钮(我需要显示这些按钮)。

这些表单按钮嵌入了另一个子(SendEmail),它根据表单按钮所在行中其他列中的信息创建电子邮件。

我似乎无法弄清楚如何根据用户在5,000行中的任何一行中单击的按钮来使单元格引用相对。

例如,如果表单按钮在N120中,如何在不重写代码5000次的情况下将单元格引用设置为c120,f120和j120(使用SendEmail中的单元格引用)。下面的代码是我到目前为止的代码:

Sub CreateButtons()
Dim i As Long
Dim shp As Object
Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHeight As Double

With Sheets("Sheet1")
    dblLeft = .Columns("N:N").Left
    dblWidth = .Columns("N:N").Width
    For i = 2 To 5000
        dblHeight = .Rows(i).Height
        dblTop = .Rows(i).Top
        Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
        shp.OnAction = "SendEmail"
        shp.Characters.Text = "Email"
    Next i
End With
End Sub

 Private Sub SendEmail()
   Dim Outlook_App As Object
   Dim Outlook_Mail As Object

   Set Outlook_App = CreateObject("Outlook.Application")
   Set Outlook_Mail = Outlook_App.CreateItem(0)
   Dim strbody As String

     strbody = "Hello," & vbNewLine & vbNewLine & _
     "Our records indicate we need to receive the following items from " & 
     Range("c2") & " on or before " & Range("f2") & ":" & vbNewLine & 
     vbNewLine & _
     "" & vbNewLine & vbNewLine & _
     "Thank you,"

  On Error Resume Next
    With Outlook_Mail
      .To = Range("j2").Value
      .Subject = "ACTION NEEDED: Request for Items"
      .body = strbody
      .display
  End With
  End Sub

1 个答案:

答案 0 :(得分:1)

虽然我同意@ Wookies-Will-Code,但如果这是你想要的,那么这就是你问题的答案。

EntityCollection<Foo>.withLoadedEntities { entities in
  entities += [Foo(), Foo()]
  EntityCollection<Foo>.withLoadedEntities { print($0) } // crash!
}

性能方面,您可以更改屏幕更新,事件和计算的切换,直到创建所有按钮,甚至不是快速子例程。在我的测试中,它仍然需要13秒才能完成,而且我的计算机速度非常快。因此,您可以使用@ Wookies-Will-Code建议并重新考虑您的程序。

Sub SendEmail()
  Dim strbody As String
  Dim This As Range   'This is where the magic starts

  'This is the actual magic.
  Set This = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address)
  '
  'Now that the parent cell object is determined, we can use a simple 
  'offset to collect the necessary data for the email body.
  '
  strbody = "To: " & This.Offset(0, -4) & vbNewLine & _
            "Subject: ACTION NEEDED: Request for Items" & vbNewLine & vbNewLine & _
            "Hello," & vbNewLine & vbNewLine & _
            "Our records indicate we need to receive the following items " & vbNewLine & _
            This.Offset(0, -11).value & " on or before " & _
            This.Offset(0, -8).value & ":" & vbNewLine & _
            vbNewLine & vbNewLine & _
            "Thank you,"
  MsgBox strbody
End Sub