Excel中的自定义旋转按钮

时间:2015-06-23 15:51:16

标签: excel vba excel-vba custom-controls imagebutton

我有一些图像,我已在工作表中指定了宏,并尝试应用参数以确保只生成有效的条目。每次单击时,旋转按钮会将单元格值增加或减少1。我已经使用数据验证标准仅允许值为2或更大(以避免负值,不存在,以及使用无效引用),但这只限制值输入时我手动键入值而不是使用按钮减少值时触发。

有没有办法应用某种

.Min 
.Max

这些形状按钮的功能?我基本上只是不希望用户能够输入低于2的值。谢谢! 现行守则:

Sub Increase_Val()

Dim StartRow As Long
Dim EndRow As Long
Dim row_number As Long

StartRow = Sheet6.Range("D5").Value 
EndRow = Sheet6.Range("D5").Value

For row_number = StartRow To EndRow
    DoEvents
Next row_number

End Sub

2 个答案:

答案 0 :(得分:1)

在您的旋转按钮宏中,您可以从单元格中读取验证设置,并决定是否增加/减少数字

Sub Tester()

    Dim c As Range
    Set c = Range("D4")

    If Not c.Validation Is Nothing Then
        If c.Validation.Type = xlValidateWholeNumber And _
                       c.Validation.Operator = xlBetween Then
            Debug.Print "Min", c.Validation.Formula1
            Debug.Print "Max", c.Validation.Formula2
        End If
    End If

End Sub

答案 1 :(得分:0)

所以我的最终解决方案最终与我想象的有点不同。使用宏和图像修改了自定义旋转按钮的概念,并使用表单控件旋转按钮。完整代码使用包含信息的已定义表单中的信息,并使用个性化信息和HTML格式填充通用消息。我的旋转按钮是为了帮助我选择我想要包含的行范围(因为该函数使用.Display方法而不是。发送,因为我想在每个电子邮件发出之前亲自检查每个电子邮件,并且有很多行,这使我能够更轻松地决定我想一次显示多少封电子邮件)。首先是电子邮件代码(由Alex Cantu原始作品定制):

Sub SendMyEmals(what_address As String, subject_line As String, mail_body_message As String)
Dim olApp As Outlook.Application
Dim oAttach As Outlook.Attachment

Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem

Set olMail = olApp.CreateItem(olMailItem)

With olMail

.To = what_address
.Attachments.Add = "C:\",olByValue, 0
'your directory reference, I used this for my header image", 
.Attachments.Add = "C:\",olByValue, 0
'other directory reference, used for footer image
.Subject = "Pick your subject"
.BodyFormat = olFormatHTML
.HTMLBody = "<img src='cid:"Your_image_name'"&"width = 'whatever' height = 'whatever' <br> <br>" mail_body_message & "&"img src='cid:Your_other_image'" &"width = 'whatever' height = 'whatever'>"
.Display
End With
End Sub


Sub MassEmail()

Dim mail_body_message As String
Dim A As String
Dim B As String
Dim C_name As String
Dim D As String
Dim RowStart As String
Dim RowEnd As String
Dim row_number As String

With Worksheets("Your_Worksheet")

RowStart = SheetX.Range("Your Range").Value
'this is the sheet where I stored the generic HTML message where I used replace text to be filled in by the row ranges from the main sheet "Your_Worksheet"
RowEnd = SheetX.Range("Your Other Range").Value

For row_number = RowStart To RowEnd
DoEvents

mail_body_message = SheetX.Range("Where the HTML was stored")

A = Sheet1.Range("A" & row_number)
B = Sheet1.Range("B" & row_number)
C = Sheet1.Range("C" & row_number)
D = Sheet1.Range("D" & row_number)

what_address = Sheet1.Range("D"& row_number)
'that is the column where I stored the individual email addresses

mail_body_message = Replace(mail_body_message, "replace_A_here", A)
mail_body_message = Replace(mail_body_message, "replace_B_here", B)
mail_body_message = Replace(mail_body_message, "replace_C_here", C)
mail_body_message = Replace(mail_body_message, "replace_D_here", D)

Call SendMyEmails(Sheet1.Range("D"&row_number), "This is a test email", mail_body_message

Next row_number
End With

End Sub

无论如何,它按照我想要的方式工作,我相信可能有更优雅的方法来做到这一点,但我现在对此解决方法感到满意。