M
marc21
Guest
Rebonjour à tous,
Voila, lors de mon enreistrement d'un de mes fichiers, la demande est d'enregistrer sous un nom bien défini, tout va bien jusque là,
mais est-il possible sur le nouveau fichier de supprimer, les boutons de ces nouvelles feuilles ou les rendrent inactifs pour le nouveau fichier qui à été créer , et surtout qu'elles restent visibles et fonctionnelles dans le fichier maitre. et de plus comme cela , il ne me demanderas plus la liaison entre les 2 fichiers à l'ouverture.
Voici mon code pour l'enregistrement du nouveau fichier :
Private Sub CommandButton1_Click()
Dim Fichier As String
Dim iMsg As Object, iConf As Object, iBP As Object
Const cdoSendUsingPickup = 1
Fichier = Worksheets("Jan 04").Range("a100").Value & " " & Format(Date, "d mm yy") & " " & Format(Time, "h mm ss") & ".xls"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Jan 04").Copy
ActiveWorkbook.SaveAs Filename:="C:\Test\" & Fichier
ActiveWorkbook.Close 'fermer le classeur enregistré
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.To = "marcmarc150@hotmail.com"
.Subject = "Pointage" & Worksheets("Jan 04").Range("a100").Value
.HTMLBody = "Voici mon test ..." 'corps du Message
Set iBP = iMsg.AddAttachment("C:\Test\" & Fichier)
.Send 'envoi
End With
Application.ScreenUpdating = True
Sheets("Janvier 1").Select
End Sub
Merci
Marc21
Voila, lors de mon enreistrement d'un de mes fichiers, la demande est d'enregistrer sous un nom bien défini, tout va bien jusque là,
mais est-il possible sur le nouveau fichier de supprimer, les boutons de ces nouvelles feuilles ou les rendrent inactifs pour le nouveau fichier qui à été créer , et surtout qu'elles restent visibles et fonctionnelles dans le fichier maitre. et de plus comme cela , il ne me demanderas plus la liaison entre les 2 fichiers à l'ouverture.
Voici mon code pour l'enregistrement du nouveau fichier :
Private Sub CommandButton1_Click()
Dim Fichier As String
Dim iMsg As Object, iConf As Object, iBP As Object
Const cdoSendUsingPickup = 1
Fichier = Worksheets("Jan 04").Range("a100").Value & " " & Format(Date, "d mm yy") & " " & Format(Time, "h mm ss") & ".xls"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Jan 04").Copy
ActiveWorkbook.SaveAs Filename:="C:\Test\" & Fichier
ActiveWorkbook.Close 'fermer le classeur enregistré
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.To = "marcmarc150@hotmail.com"
.Subject = "Pointage" & Worksheets("Jan 04").Range("a100").Value
.HTMLBody = "Voici mon test ..." 'corps du Message
Set iBP = iMsg.AddAttachment("C:\Test\" & Fichier)
.Send 'envoi
End With
Application.ScreenUpdating = True
Sheets("Janvier 1").Select
End Sub
Merci
Marc21