Clear Shape and keep Text Box

BeginnerB

New Member
Joined
Nov 11, 2022
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
Is it possible to make macro that clear Shape and skip TextBox ?
There is my code, but I get all deleted.
Thank you

Sub SacuvajPonuduExcel()

Dim shp As Shape


path = "C:\Users\Bojan\Documents\Ponuda\Excel\"
radninalog = Range("C10")
klijent = Range("G2")
dt_issue = Range("B11")
fname = radninalog & " - " & klijent

Application.DisplayAlerts = False

Sheet1.Copy

For Each shp In ActiveSheet.Shapes
If shp.Type <> msoPicture Then shp.Delete
Next shp

With ActiveWorkbook
.Sheets(1).Name = "Ponuda"
.SaveAs Filename:=path & fname, FileFormat:=51
.Close
End With

Application.DisplayAlerts = True

Set nextrec = Sheet2.Range("A1048576").End(xlUp).Offset(1, 0)
nextrec = radninalog
nextrec.Offset(0, 1) = klijent
nextrec.Offset(0, 2) = dt_issue


Sheet2.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".xlsx"
End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Try:

VBA Code:
  For Each shp In ActiveSheet.Shapes
    If shp.Type <> msoPicture Then
      If shp.Type = msoTextBox Then
        'What do you want to do if it is textbox?
        shp.TextFrame2.TextRange.Characters.Text = ""
      Else
        'If it's not textbox, you want to clean:
        shp.TextFrame2.TextRange.Characters.Text = ""
        'or delete
        'shp.Delete
      End If
    End If
  Next shp

Or just clear except textbox
VBA Code:
  For Each shp In ActiveSheet.Shapes
    If shp.Type <> msoPicture Then
      If shp.Type <> msoTextBox Then
        shp.TextFrame2.TextRange.Characters.Text = ""
      End If
    End If
  Next shp
 
Upvote 0
Sorry but it doesn't work, maybe I didn't put in the wright place in code. Can you put in my code?
I have macro buttons that are shapes and there need to be deleted. TextBox need to stay, with my code buttons and TextBox are deleted.
Thank you.
 
Upvote 0
Try this:

VBA Code:
Sub SacuvajPonuduExcel()

  Dim shp As Shape
 
  Path = "C:\Users\Bojan\Documents\Ponuda\Excel\"
  radninalog = Range("C10")
  klijent = Range("G2")
  dt_issue = Range("B11")
  fname = radninalog & " - " & klijent
 
  Application.DisplayAlerts = False
 
  Sheet1.Copy
 
  For Each shp In ActiveSheet.Shapes
    If shp.Type <> msoPicture Then
      If shp.Type <> msoTextBox Then
        shp.Delete
      End If
    End If
  Next shp
 
  With ActiveWorkbook
  .Sheets(1).Name = "Ponuda"
  .SaveAs Filename:=Path & fname, FileFormat:=51
  .Close
  End With
 
  Application.DisplayAlerts = True
 
  Set nextrec = Sheet2.Range("A1048576").End(xlUp).Offset(1, 0)
  nextrec = radninalog
  nextrec.Offset(0, 1) = klijent
  nextrec.Offset(0, 2) = dt_issue
 
  Sheet2.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=Path & fname & ".xlsx"
End Sub
 
Upvote 0
Solution
DanteAmor - thank you for your solution - this code worked 100% for an identical issue I was having...

BeginnerB - thank you for your question
 
Upvote 1

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top