archiver et supprimer botton

[STIRLING]

salut
qui peut m'aider à résoudre ce problème une erreur

merci

 

[DoubleZero]

Re : archiver et supprimer botton

Bonjour, STIRLING, le Forum,

Comme ceci ?

Option Explicit
Sub Bouton_type_x_supprimer()
    Dim s As Shape
    For Each s In ActiveSheet.Shapes
        If s.Type = 8 Then s.Delete
    Next s
End Sub

A bientôt 🙂

 

[STIRLING]

Re : archiver et supprimer botton

il ya une erreur quand je l'applique
ActiveSheet.Shapes.Range(Array("ARCHIVE")).Delete voila erreur

Sub ARCH()



Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim wkbSource As Workbook
Dim strChildPath As String
Dim FSO As Scripting.FileSystemObject
Dim strSubFolderName As String
Dim PathA As String





Set FSO = New FileSystemObject


strSubFolderName = ThisWorkbook.Sheets(1).Range("I9")
strChildPath = ThisWorkbook.Sheets(1).Range("N22")

If strSubFolderName = vbNullString Or strChildPath = vbNullString Then

MsgBox "Sub Folder or Child Path Missing", vbCritical
Exit Sub

End If


strSubFolderName = Format(Replace(strSubFolderName, "\", "-"), "mm-yyyy")
CheckAndCreateFolder "C:\inventory\"

Path = "C:\Inventory\" & strSubFolderName & "\"
CheckAndCreateFolder Path

PathA = Path & strChildPath & "\"
CheckAndCreateFolder PathA

FileName1 = ThisWorkbook.Sheets(1).Range("H6")
FileName2 = ThisWorkbook.Sheets(1).Range("N22")

If FileName1 = vbNullString Or FileName2 = vbNullString Then

MsgBox "File Name 1 or File Name 2 is missing ", vbCritical
Exit Sub

End If


Set wkbSource = ThisWorkbook



'wkbSource.SaveCopyAs PathA & FileName1 & "_" & FileName2 & ".xlsm" ', FileFormatvalue = 52
'ActiveWorkbook.Close savechanges:=False

Application.DisplayAlerts = False
wkbSource.Worksheets(1).Copy
ActiveSheet.Shapes.Range(Array("ARCHIVE")).Delete
ActiveWorkbook.SaveAs PathA & FileName1 & "_" & FileName2 & ".xlsx", xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False

End Sub


Function CheckAndCreateFolder(strFolderName As String)

Dim FSO As FileSystemObject
Set FSO = New FileSystemObject

If Not FSO.FolderExists(strFolderName) Then

FSO.CreateFolder (strFolderName)

End If





End Function