VBA: Chiffrer livrele EXCEL avec mot de passe -> Macro vide

Y compris Power BI, Power Query et toute autre question en lien avec Excel
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'966
Appréciations reçues : 358
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 9 mars 2017, 14:53

bonjour,

regarde l'instruction thisworkbook.saveas

https://msdn.microsoft.com/en-us/librar ... 41185.aspx
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 9 mars 2017, 15:50

Le problème c´est que je sauvegarde pas mon fichier. dans ma macro, il s´envoie directement en dupliquant dans un nouveau libre et en l´envoyant.
Avatar du membre
eriiic
Passionné d'Excel
Passionné d'Excel
Messages : 9'309
Appréciations reçues : 370
Inscrit le : 7 février 2010
Version d'Excel : 2010fr

Message par eriiic » 9 mars 2017, 18:30

Va plutôt sur un forum de ta langue d'origine car là tu t'expliques mal et on ne comprend rien.
eric
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.
(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 10 mars 2017, 09:40

Ahaha merci pour le conseil mais je suis Français, né en France, vacciné en France etc... J´ai juste un clavier diffèrent et une autocorrection un peu bizarre parfois car je travaille en Espagne.

Je reformule:

Je souhaite intégrer, à une macro déjà existante, des lignes de codes permettant de protéger le fichier Excel avec mot de passe. Donc de le chiffrer.


Personne n´a pu m´aidé pour l´instant. Et je veux que ce soit tout le fichier Excel qui soit protéger, de façon a ce que on doit entrer un mot de passe pour l´ouvrir après le double clic.

Ma macro actuelle, crée une copie d´un onglet de mon fichier dans un nouveau fichier, fait des manipulations dessus, et l´envoie via Outlook a des destinataires. Je ne souhaite donc pas sauvegarder ce fichier, juste que sa lecture soit protéger par mot de passe.
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'966
Appréciations reçues : 358
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 10 mars 2017, 10:53

bonjour,

tu le sauves avec un mot de passe
tu l'envoies
tu supprimes le fichier sauvé avec un mot de passe
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 10 mars 2017, 11:49

Et tu as le code VBA pour faire cela ?
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'966
Appréciations reçues : 358
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 10 mars 2017, 16:39

bonjour
Sub aargh()
  Set wb = ThisWorkbook
  fp = wb.FullName
  Application.DisplayAlerts = False
  wb.SaveAs "test.xlsx", 51, "tonpassword"

  'tes instructions pour envoyer le fichier test.xlsx

  wb.SaveAs fp, 52
  Kill "test.xlsx"
  Application.DisplayAlerts = True
End Sub
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 13 mars 2017, 08:49

Hola!

J´ai essayé de l´integrer a ma macro, mais j´ai pas mal d´erreur. Tu pourrais me dire quoi remplacer please?

Dans ma macro actuelle le fichier est sauvegarder comme Temp, et envoyé puis supprimer:
Sub mail()
'Fonctionne sous excel 2000-2013


    ActiveSheet.Name = "Leads del " & ThisWorkbook.Sheets("oxo").Range("c4").Value
    
    
Dim i%
For i = 200 To 5 Step -1
If Cells(i, 6).Value <> "RSHOP" Then Rows(i).EntireRow.Delete
Next i


    Columns("B:N").Select
    Range("N1").Activate
    Selection.EntireColumn.Hidden = False

    Range("N5").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'LISTING RED'!C[-12]:C[-4],5,0)"
    Range("N5").Select
    Selection.AutoFill Destination:=Range("N5:N50"), Type:=xlFillDefault
    Columns("N:O").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="#n/a", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Range("A1").Select
    
    
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim strbody As String
Dim ligne1, ligne2, ligne3, ligne4 As String

'Définition des diférentes lignes du corps du message en format HTML

ligne1 = "<font color=#1F5681 Size = 4 >Buenos días " & ThisWorkbook.Sheets("oxo").Range("b8").Value & "<br>" & "<br>"

ligne2 = "<font color=#1F5681 Size = 4 >Os adjunto el fichero Excel con los leads a contactar al día del " & ThisWorkbook.Sheets("OXO").Range("b4").Value & "." & "<br>" & "<br>"
    
ligne3 = "<font color=#1F5681 Size = 4 >Hoy, hay " & ThisWorkbook.Sheets("oxo").Range("b6").Value & " leads SRC a contactar." & "<br>" & "<br>"
    
ligne4 = "<font color=#1F5681 Size = 4 >Muchas gracias " & "<br>" & "<br>"
        

'Intégralité du texte du corps du message
strbody = ligne1 & ligne2 & ligne3 & ligne4
              
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

    'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook

    'Détermine la version d'excel et l'extension de format
With destwb

    If Val(Application.Version) < 17 Then
        'Utilisation de excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'Utilisation de excel 2007-2013
        Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        'Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
End With
    
'Désactiver fenêtre de compatibilité
        Application.DisplayAlerts = False
        
    'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

' Suppression de l'image du bouton "MAIL"
If Val(Application.Version) > 17 Then
ActiveSheet.Shapes("Rectangle à coins arrondis 10").Delete
End If


    Rows("1:3").Select
    Range("A3").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    ActiveWindow.SmallScroll Down:=-12
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select

  

With destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .display
        .To = ThisWorkbook.Sheets("OXO").Range("b9").Value & ";" & ThisWorkbook.Sheets("OXO").Range("b10").Value
        .CC = ThisWorkbook.Sheets("OXO").Range("b12").Value & ";" & ThisWorkbook.Sheets("OXO").Range("b13").Value & ";" & ThisWorkbook.Sheets("OXO").Range("b14").Value & ";" & ThisWorkbook.Sheets("OXO").Range("b15").Value
        .BCC = ""
        .Subject = "Lead para contactar del " & ThisWorkbook.Sheets("OXO").Range("C4").Value
        .Attachments.Add destwb.FullName
        .htmlbody = strbody & .htmlbody

    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

    'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    
 
    
  ActiveSheet.Name = "LEAD PARA CONTACTAR"
    
    

End Sub

Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 17 mars 2017, 13:12

Up, toujours pas reussi a le faire :(
Avatar du membre
synergy
Membre habitué
Membre habitué
Messages : 96
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par synergy » 17 avril 2017, 15:28

Bonjour le fórum,

Up, quelqu´un pour m´aider?
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Mot de passe VBA
    par lastadn » 20 avril 2016, 11:38 » dans Excel - VBA
    2 Réponses
    328 Vues
    Dernier message par lastadn
    20 avril 2016, 13:04
  • Vba mot de passe
    par massari59264 » 23 mai 2019, 14:24 » dans Excel - VBA
    38 Réponses
    430 Vues
    Dernier message par GGautier
    28 mai 2019, 14:55
  • VBA Mot de passe
    par massari59264 » 17 mai 2019, 11:15 » dans Excel - VBA
    5 Réponses
    147 Vues
    Dernier message par massari59264
    21 mai 2019, 11:26
  • Mot de passe VBA
    par MPETIT » 26 juillet 2019, 09:24 » dans Excel - VBA
    2 Réponses
    67 Vues
    Dernier message par MPETIT
    26 juillet 2019, 09:34
  • Macro mot de passe
    par Tartifletan » 15 octobre 2018, 18:01 » dans Excel - VBA
    4 Réponses
    244 Vues
    Dernier message par Xmenpl
    17 octobre 2018, 17:01
  • VBA project mot de passe
    par panda10 » 2 octobre 2015, 19:43 » dans Excel - VBA
    1 Réponses
    538 Vues
    Dernier message par LouReeD
    2 octobre 2015, 20:00