Microsoft 365 Simplification de mon code VBA

Keiko · 18 Mai 2022

Bonjour,

voici un code qui fonctionne mais je souhaiterais voir si il ne peut pas être amélioré.
Le code permet de choisir un fichier fermé, de l'ouvrir et copier les cellules choisies et de les coller dans le fichier ouvert en fermant tout de suite après une fois coller le fichier à la base fermé.

J'ai plusiuers cellules a copier et je voulais savoir si on ne pouvait simplifier le codage afin de toutes les ajouter sans devoir tout le temps recopier ce code
"NewBook.Activate
Sheets("L").Range("G14:G21").Copy
nomUn.Activate
Worksheets("L").Range("G14:G21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False"

De plus, ca fonctionne quand même mais je recois tout le temps à la fin un message me disant "Vous n'avez pas sélectionné de fichier" alors que tout a fonctionné.

Merci pour votre aide !

VB:

Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False Then
          
        Copie (QuelFichier)
          
        End If
    
        MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
  
Sub Copie(QuelFichier)
Dim nomUn, NewBook As Workbook 'Modification ici
Set nomUn = ThisWorkbook
 
Set NewBook = Workbooks.Open(QuelFichier)  'Modification ici
NewBook.Activate
Sheets("L").Range("D14:D21").Copy
nomUn.Activate
Worksheets("L").Range("D14:D21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
NewBook.Activate
Sheets("L").Range("G14:G21").Copy
nomUn.Activate
Worksheets("L").Range("G14:G21").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
 
NewBook.Close False
 
End Sub

fanch55 · 18 Mai 2022

Bonjour,
Une simplification parmi tant d'autres :

VB:

Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Target As Worksheet, Plage As Variant
Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.ScreenUpdating = True
 
End Sub

Deadpool_CC · 18 Mai 2022

Salut.
Après c'est toi qui va maintenir le Code donc ce que tu as fait = tu le comprends et maitrise
C'est mieux de le conserver pour son évolution future
Selon moi ... faut penser optimisation s'il y a des soucis de performance avant tout
Enfin ce que j'en dis ... tu fera bien comme tu veux ... lol

Keiko · 18 Mai 2022

Un grand merci

Quand le fichier fermé s'ouvre pour copier les cellules avant de rentrer, il y a un User et un mot de passe à encoder.
Possible que quand il s'ouvre, il encode le User et le Mot de passe ainsi pas d'encodage et il coipe et colle directement dans le fichier ouvert?

Voici un code que j'utilise pour le débloquer mais ca marche avec le code ci-dessus.

Peut-on l'incorporer dans le code ci-dessus?

VB:

'on saisit le user
    User = InputBox("Veuillez saisir votre nom d'utilisateur", "Utilisateur")
'on saisit le mot de passe
    MDP = InputBox("Veuillez saisir votre mot de passe", "Mot de passe")

ElseIf User = "JD" And MDP = "Jpc42*" Then
            For i = 1 To ThisWorkbook.Sheets.Count
             If Sheets(i).Name <> "Intro" Then Sheets(i).Visible = True
            Next
            Worksheets("L").[D10] = "Jonathan Dethier"
            
            Application.ScreenUpdating = True

fanch55 · 18 Mai 2022

C'est une macro automatique qui s'ouvre à l'ouverture du classeur ?
Je n'ai pas assez d'éléments pour bien répondre ...
Il me faudrait le code du Workbook_Open

Keiko · 18 Mai 2022

Merci pour ton aide.

J'ai créé un bouton pour ouvrir un excel fermé copier des cellules vers le dossier ou se trouve le bouton.
Pour le moment à l'ouverture du fichier source (fichier fermé), on doit encoder le User et MP pour l'ouvrir et qu'il copie et colle vers le fichier ouvert (avec le bouton).

Voici le code qui permet de faire ca :

VB:

Sub recuperer()

Dim QuelFichier
    QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Target As Worksheet, Plage As Variant
Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.ScreenUpdating = True
 
End Sub

Pourrait-on à l'ouverture faire en sorte qu'il donne le user et le mot de passe ainsi on aurait pas besoin de l'encoder et cela se ferait autommatiquement.

Voici le :

User : JD
MP : Jpc42*

Une fois encodé cela ouvre le fichier et ainsi copie et colle vers le fichier ouvert.

Ai-je été assez précis?

Bien à toi,

fanch55 · 18 Mai 2022

Keiko à dit:
Voici le code qui permet de faire ca :

C'est le code que je vous ai fourni.

Keiko à dit:
Pourrait-on à l'ouverture faire en sorte qu'il donne le user et le mot de passe ainsi on aurait pas besoin de l'encoder et cela se ferait autommatiquement.

C'est à dire, demander un user et un mot de passe avant d'effectuer l'ouverture du fichier à copier ?

Keiko · 18 Mai 2022

Oups oui c'est vous

Oui je ne sais pas exactement quand le faire.
Mais une fois que mon excel s'ouvre il demande un User et MP et je souhaiterais que ca s'encode automatiquement ainsi plus besoin de l'écrire.

fanch55 · 19 Mai 2022

Voyez si le classeur joint vous convient .

Keiko · 19 Mai 2022

Merci pour ton aide mais malheureusement ce n'est pas ca.

Voici le code dans le Thisworkbook

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'on affiche la feuille Vierge
    Sheets("L").Visible = True
'on planque toutes les autres feuilles sauf Vierge
    For x = 1 To ThisWorkbook.Sheets.Count
        If Sheets(x).Name <> "L" Then Sheets(x).Visible = xlSheetVeryHidden
    Next
 
End Sub

Private Sub Workbook_Open()
      On Error Resume Next
    Application.ScreenUpdating = False
'on defini un pointeur
    Pointeur = 0
    
'on affiche la feuille Vierge
    Sheets("L").Visible = True
'on va dessus
    Sheets("L").Activate
'on planque toutes les autres
    For x = 1 To ThisWorkbook.Sheets.Count
        If Sheets(x).Name <> "L" Then Sheets(x).Visible = xlSheetVeryHidden
    Next
  
'on saisit le user
    User = InputBox("Veuillez saisir votre nom d'utilisateur", "Utilisateur")
'on saisit le mot de passe
    MDP = InputBox("Veuillez saisir votre mot de passe", "Mot de passe")
  
'Derniere ligne du tableau de la feuille DroitsUsers pour boucler dessus
    DerLigne = Sheets("DroitsUsers").Range("A65536").End(xlUp).Row
  
'on boucle pour trouver les occurences, x=2 car je pars du principe que la premiere ligne _
contient les entetes de colonne
    For x = 2 To DerLigne
'si ce qu'il y a dans la colonne1 (Colonne A : user) = le user saisi _
ET ce qu'il y a dans la colonne2 (Colonne B : mot de passe)
        If Worksheets("DroitsUsers").Cells(x, 1) = User And Worksheets("DroitsUsers").Cells(x, 2) = MDP Then
'on affiche la feuille définié en colonne3 (Colonne C : Onglet autorisé)
'on affiche la feuille correspondante
            FeuilleVisible = Worksheets("DroitsUsers").Cells(x, 3)
            Sheets(FeuilleVisible).Visible = True
'on va dessus
            Sheets(FeuilleVisible).Activate
'on se met un pointeur pour voir si on trouve quelque chose, si on trouve rien on quittera
            Pointeur = Pointeur + 1
            
            Worksheets("L").[D10] = Sheets("DroitsUsers").Cells(x, 4) 'info de la colonne D : en feuille L
    

            
ElseIf User = "JD" And MDP = "Jpc42*" Then
            For i = 1 To ThisWorkbook.Sheets.Count
             If Sheets(i).Name <> "Intro" Then Sheets(i).Visible = True
            Next
            Application.ScreenUpdating = True
        Exit Sub
        
        End If
 
    Next x
 
'Si le pointeur est 0 on ferme le fichier.
    If Pointeur = 0 Then
        MsgBox "Utilisateur ou mot de passe non valide" & vbCrLf & vbCrLf & "Le fichier va se fermer", vbCritical + vbOKOnly, "Sécurité"
        ActiveWorkbook.Close SaveChanges:=False
    End If
 
    Application.ScreenUpdating = True
End Sub

Ca ouvre une première demande le User puis MP et ca permet de rentrer dans l'excel qu'on ouvre.

Il faudrait que quand il ouvre le fichier pour aller copier, le code se met automatiquement s'en l'encoder.

Possible?

Bien à toi,

fanch55 · 19 Mai 2022

Tous les classeurs concernés ont ce code ?
ou c'est seulement celui sur lequel on va faire récupérer ?

Keiko · 19 Mai 2022

Ils ont tous ce code oui

fanch55 · 20 Mai 2022

OK, on va donc ouvrir les classeurs à copier sans activer leur macro .

Mais j'attire votre attention sur 2 points:

afficher un mot de passe en clair , c'est pas bien ...
on peut toujours faire Ctrl+Attn pour arrêter la macro en cours

VB:

Sub recuperer()
Dim QuelFichier As Variant: QuelFichier = Application.GetOpenFilename("Excel, *.xlsm")
    
    If QuelFichier <> False _
    Then Copie (QuelFichier) _
    Else MsgBox "Vous n'avez pas sélectionné de fichier"
        
End Sub
 
Sub Copie(QuelFichier)
Dim Plage As Variant
Dim Target As Worksheet: Set Target = ThisWorkbook.Worksheets("L")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Workbooks.Open(QuelFichier)
        For Each Plage In Array("D14:D21", "G14:G21")
            .Worksheets("L").Range(Plage).Copy
            Target.Range(Plage).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Next
        .Close False
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
End Sub

Keiko · 20 Mai 2022

L'idée est que cela s'encode sans se voir.

Pensez-vous que cela soit possible?

fanch55 · 20 Mai 2022

Keiko à dit:
L'idée est que cela s'encode sans se voir

C'est bien ce que fait la macro fournie

Microsoft 365 Simplification de mon code VBA

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Pièces jointes

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Keiko

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Discussions similaires