PDA

View Full Version : Sleeper: Reset CommandButton Caption after creating PDF



kaedinsh
08-11-2023, 03:44 AM
Hello!

I'm looking for help with this code - hopefully you can help me. I'm a complete beginner in Excel so if there's any information missing I'm happy to provide!

I have an Excel spreadsheet that I want to turn into a sort of checklist. Once all the items in the checklist have been checked, I want to turn the checklist into a pdf and send it to a specific email address. I already have a code for this that works.
However, the checkmarks should not be done via a checkbox (too small) but via a command button. When triggered, the caption in the command button changes from "empty" to "ok" and when triggered again back to empty.

I have codes for both these things. However, I am trying to find a solution to reset the command buttons back to "empty" after the pdf has been created. I already have implemented this for some cell values but I don't know if this is possible for command buttons as well. Any help is much appreciated.

Here is my code:

for pdf creation:


Private Sub CommandButton1_Click()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim xPath As String
Dim xMemberName As String
Dim xMemberName1 As String
Dim xFileDate As String
Dim wFolder As String
Dim wDynamic As String
Set xSht = ActiveSheet
xPath = Range("X8")
xMemberName = Range("E9").Value
xMemberName1 = Range("E13").Value
xFileDate = Format(Now, "mm-dd-yyyy-hh-mm")
xFolder = xPath + xFolder + "" + xSht.Name + "-" + xMemberName + "-" + xMemberName1 + "-" + xFileDate + ".pdf"
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = "EMAIL"
.CC = ""
.Subject = xSht.Name + "-" + xMemberName + "-" + xMemberName1 + "-" + xFileDate + ".pdf"
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
Range("E9:f9").ClearContents
Range("E13:f13").ClearContents
Range("S9:t9").ClearContents
Range("D17:D18").ClearContents
Range("D23:D26").ClearContents
Range("D31:D64").ClearContents
Range("D69:D92").ClearContents
Range("D97:D118").ClearContents
Range("D121:S129").ClearContents
End Sub


This is for the buttons to change the caption:


Private Sub CommandButton10_Click()
With CommandButton10
If .Caption = "" Then
.Caption = "OK"
ElseIf .Caption = "OK" Then
.Caption = ""
Else
.Caption = ""
End If
End With
End Sub


Any ideas?

Aussiebear
08-11-2023, 04:11 AM
Welcome to VBAX kaedinsh. Please wrap your supplied code with code tags, as this improves the readability. I've taken the opportunity to do this for you this time.

georgiboy
08-21-2023, 01:53 AM
If you are looking for a way to reset all of the commandbuttons in one go then maybe the below will help:

Sub test()
Dim btn As Object

For Each btn In Sheet1.Shapes
If Left(btn.Name, 13) = "CommandButton" Then
Set btn = Sheet1.OLEObjects(btn.Name)
With btn.Object
If .Caption = "" Then
.Caption = "OK"
ElseIf .Caption = "OK" Then
.Caption = ""
Else
.Caption = ""
End If
End With
End If
Next btn
End Sub