Custom Spin Button in Excel

1.3k views Asked by At

I have images that I have assigned macros to in a worksheet and am trying to apply parameters to ensure that only valid entries are made. The spin button increase or decrease a cell value by a value of 1 on each click. I have used data validation criteria to only allow for values of 2 or greater (to avoid negative values, which don't exist, as well as using invalid references), but this only limits value entries when I type them in manually and is not firing when the buttons are used to decrease the values.

Is there a way to apply a sort of

.Min 
.Max

function to these shape-buttons? I basically just do not want the user to be able to enter values below 2. Thanks! Current Code:

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

There are 2 answers

5
Tim Williams On BEST ANSWER

In your spin button macro, you can read the validation settings from the cell and decide whether to increment/decrement the number

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
0
user3794203 On

So my final solution ended up being a bit different than I was envisioning. Nixed the idea of a customized spin button using macros and images and went with the form control spin buttons. The full code uses information in a defined sheet that contains information and populates a generic message with personalized information and HTML formatting. My spin button was to help me pick what range of rows I wanted to include (since the function is using the .Display method rather than .Send as I wanted to personally check each email before it went out, and there were a lot of rows, this enabled me to more easily decide how many emails I wanted to display at one time). First the e-mail code (customized from an original work by 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

Anyway, it worked the way I was trying to get it to, I am sure there may have been more elegant ways to do it, but I am happy with this workaround for now.