How can I remove specific shapes using VBA code without removing other shapes that I have in my worksheet when saving it as a new .xlsx file?

Question

Hello Everyone,

I need help with VBA coding... I will definitely appreciate all of your suggestions. :)

* I'm not an expert on this, I only follow a lot of youtube tutorials. *

I need to remove a specific shape under my Macro-Enabled Workbook.

What I want is when I click on "Add to Database" button, the active workbook will be saved as a new workbook on a specific path and filename as .xlsx

under the image below I encircled those Buttons that I need to remove, however, I only have a code that will remove all the shapes under my worksheet, including my logo photo, checkboxes, and text box...

Here's the code:

Sub Recordofjobcards()

Dim jobcardno As String

Dim dateissued As Date

Dim Custname As String

Dim phoneno As String

Dim amt As Currency

Dim nextrec As Range

jobcardno = Range("b7")

dateissued = Range("H7")

Custname = Range("c9")

phoneno = Range("c11")

amt = Range("G17")

fname = jobcardno

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = jobcardno

nextrec.Offset(0, 1) = dateissued

nextrec.Offset(0, 2) = Custname

nextrec.Offset(0, 3) = phoneno

nextrec.Offset(0, 4) = amt

path = "C:\Users\LENOVO\OneDrive\LOSH CARS 2023\Job Cards\June.XLSX"

'copy the jobcard sheet to a new workbook

Sheet2.Copy

'then delete command buttons on the worksheet

---

Dim shp As Shape

---

For Each shp In ActiveSheet.Shapes

shp.Delete

Next shp

'save the new workbook to a specified folder

With ActiveWorkbook

.Sheets(1).Name = "jobcard"

.SaveAs Filename:=path & fname, FileFormat:=51

.Close

End With

'need to put the details of the jobcard in the record of jobcards sheet

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"

path = "C:\Users\LENOVO\OneDrive\LOSH CARS 2023\Job Cards\June\PDF"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

End Sub

Only those buttons (form button) that I want to remove.

[![](https://learn-attachment.microsoft.com/api/attachments/3d4bd865-8bc9-4358-8a81-e3339df9d0f0?platform=QnA

Answer 1

Hi,

try and this approach

Copy active sheet as new workbook (on Desktop)

and delete specific form control buttons

that depend on Caption name (option Yes-No)

vba macro

[update..]

Sub SaveAs_NewWb_DeleteButtons() 

'## 05-Jun-2023 ## 

Dim wb1 As Workbook, wb2 As Workbook 

Set wb1 = ThisWorkbook 

Dim shtName 

shtName = ActiveSheet.Name 

Dim sPath As String 

Application.DisplayAlerts = False 

sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & shtName & ".xlsx" 

ActiveSheet.Copy 

ActiveWorkbook.SaveAs sPath 

Set wb2 = ActiveWorkbook 
Dim s As Button, ws As Worksheet

Set ws = wb2.Sheets(1)

For Each s In ws.Buttons

If MsgBox( _

"Delete button ?? " & vbCr & _

"Caption Name is :" & vbCr & _

s.Caption, vbYesNo) = vbNo Then GoTo nnext

s.Delete

nnext:

Next s

Application.DisplayAlerts = True

wb2.Save

wb2.Close False

End Sub

Answer 2

I assume that the buttons that you encircled are ActiveX command buttons.

On the Developer tab of the ribbon, in the Controls group, click to highlight Design View.

Click on the first button and you'll see the name of the shape in the name box on the left hand side of the formula bar.

Select and copy the name. For illustration purposes, I'll use CommandButton1.

Switch to the Visual Basic Editor and insert the line

    ActiveSheet.Shapes("CommandButton1").Delete

where CommandButton1 is the name of the button shape.

Switch back to Excel, and repeat these steps for each of the other buttons.

When you're done, click to unhighlight Design View.

(And don't forget to remove the loop that deletes all shapes!)

Answer 3

those buttons are under "FORM CONTROLS" is it the same when I use the code you recommend?

Answer 4

In that case, you don't have to activate 'Design View'. Instead, right-click on a button to select it.

The rest remains the same.

Answer 5

I got this Error.

Sub Recordofjobcards()

Dim jobcardno As String

Dim dateissued As Date

Dim Custname As String

Dim phoneno As String

Dim amt As Currency

Dim nextrec As Range

jobcardno = Range("b7")

dateissued = Range("H7")

Custname = Range("c9")

phoneno = Range("c11")

amt = Range("G17")

fname = jobcardno

Set nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = jobcardno

nextrec.Offset(0, 1) = dateissued

nextrec.Offset(0, 2) = Custname

nextrec.Offset(0, 3) = phoneno

nextrec.Offset(0, 4) = amt

path = "C:\Users\LENOVO\OneDrive\LOSH CARS 2023\Job Cards\June.XLSX"

'copy the jobcard sheet to a new workbook

Sheet2.Copy

'then delete command buttons on the worksheet

ActiveSheet.Shapes("Button 18").Delete

ActiveSheet.Shapes("Button 34").Delete

ActiveSheet.Shapes("Button 26").Delete

ActiveSheet.Shapes("Button 31").Delete

'save the new workbook to a specified folder

With ActiveWorkbook

.Sheets(1).Name = "jobcard"

.SaveAs Filename:=path & fname, FileFormat:=51

.Close

End With

'need to put the details of the jobcard in the record of jobcards sheet

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 7), Address:=path & fname & ".xlsx"

path = "C:\Users\LENOVO\OneDrive\LOSH CARS 2023\Job Cards\June\PDF"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=path & fname

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

End Sub