Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Nouveau Candidat au Club
    Inscrit en
    août 2007
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2007
    Messages : 3
    Points : 1
    Points
    1
    Par défaut Demande d’explications sur cette macro et aide pour la modifier.
    Bonjour

    J’ai des opérations à effectuer sur des macros suite à une fusion de fichiers et à une modification de l’emplacement du tableau.
    Mon problème, c’est que je débute dans Excel et le Vba, et que j’ai encore du mal à comprendre les macros d’origine.


    Voici le code source

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    Sub Distrib_WC()
    '
    ' Distrib_WC Macro
     
    'Copie de fichier Base avant L1 WC
        ChDir _
           "P:\###########\Base WC"
        Workbooks.Open Filename:= _
            " P:\############\Base WC\ ANALYSE DU MIX PAR FAMILLE DE WC\BASE AVANT.xls" _
            , UpdateLinks:=3
        Sheets(1).Copy After:=Workbooks( _
            NomFichierWCJour). _
            Sheets(1)
        Windows("BASE AVANT .xls").Activate
        Application.DisplayAlerts = False
        ActiveWindow.Close
        Application.DisplayAlerts = True
        Sheets(2).Name = "Base Avant "
        Range("A1").Select
        NbrLigneBaseAvL1 = ActiveCell.SpecialCells(xlLastCell).Row
     
    'Suppr colonne inutile
        Columns("C:S").Select
        Range("C:S,W:AH").Select
        Selection.Delete Shift:=xlToLeft
        Columns("A:E").Select
        Selection.Columns.AutoFit
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Range("A1:E1").Select
        Selection.AutoFilter
        Range("A1").Select
     
    'Application formule
        Sheets(NomFeuilleDonneesRequi).Select
        Range("A1").Select
        NbrLigneRequi = ActiveCell.SpecialCells(xlLastCell).Row
        Range("G2").Select
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'Base Avant '!R2C1:R1000C5,3,FALSE)"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Base Avant '!R2C1:R1000C5,5,FALSE)"
        Range("G2:H2").Select
        Selection.AutoFill Destination:=Range("G2:H" & NbrLigneRequi)
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Type WC"
        With ActiveCell.Characters(Start:=1, Length:=7).Font
            .Name = "Arial"
            .FontStyle = "Gras"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        Range("H1").Select
        ActiveCell.FormulaR1C1 = "WC"
        With ActiveCell.Characters(Start:=1, Length:=2).Font
            .Name = "Arial"
            .FontStyle = "Gras"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        Range("A1:J1").Select
        Selection.AutoFilter
        Selection.AutoFilter
        Range("G:G,H:H").EntireColumn.AutoFit
        Sheets(2).Select
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True
        Range("A2").Select
        Sheets(3).Select
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFiltering:=True
        Range("A2").Select
     
    End Sub
    Je dois modifier les appels sur 3 parties

    1) Changement du nom de fichier sur lequel je travaille

    2) Appel sur une feuille du classeur spécifique

    3) Changement de l’emplacement de la requête (3 lignes plus bas car insertion d’un tableau en haut de feuille)



    Je cherche à modifier les appels pour ne plus faire appel à base avant mais un autre fichier qui s’appelle base WC où les données sont sur une feuille spécifique (feuille abc)

    Je pensais rajouter une ligne du type Sheets("abc").Select

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    'Copie de fichier Base avant L1 WC
        ChDir _
           "P:\###########\Base WC"
        Workbooks.Open Filename:= _
            " P:\############\Base WC\ ANALYSE DU MIX PAR FAMILLE DE WC\BASE AVANT.xls" _
    Sheets("abc").Select
            , UpdateLinks:=3

    Ainsi qu’effectuer une modification sur le chemin d’accès

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
        ChDir _
           "P:\###########\Base WC"
        Workbooks.Open Filename:= _
            " P:\############\Base WC\ ANALYSE DU MIX PAR FAMILLE DE WC\BASE WC.xls" _
     
            Sheets(1)
        Windows("BASE WC .xls").Activate
        Application.DisplayAlerts = False
        ActiveWindow.Close
    Application.DisplayAlerts = True
        Sheets(2).Name = "Base WC "
        Range("A1").Select
        NbrLigneBaseAvL1 = ActiveCell.SpecialCells(xlLastCell).Row
     
     
    'Application formule
        Sheets(NomFeuilleDonneesRequi).Select
        Range("A1").Select
        NbrLigneRequi = ActiveCell.SpecialCells(xlLastCell).Row
        Range("G2").Select
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'Base WC '!R2C1:R1000C5,3,FALSE)"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Base WC '!R2C1:R1000C5,5,FALSE)"
        Range("G2:H2").Select
        Selection.AutoFill Destination:=Range("G2:H" & NbrLigneRequi)
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Type WC"
        With ActiveCell.Characters(Start:=1, Length:=7).Font

    Par la suite, faut il que je modifie les requêtes du Vlookup pour prendre en compte l’insertion de 3 lignes en haut du classeur ?

    Comment fonctionne le
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'Base WC '!R2C1:R1000C5,3,FALSE)"
    ?

  2. #2
    Membre émérite
    Profil pro
    Inscrit en
    juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2007
    Messages : 2 130
    Points : 2 449
    Points
    2 449
    Par défaut
    Salut Sapinator et le forum
    Sub Distrib_WC()
    ChDir _
    "P:\###########\Base WC"
    Définition du chemin et du Dossier courant
    Workbooks.Open Filename:= _
    " P:\############\Base WC\ ANALYSE DU MIX PAR FAMILLE DE WC\BASE AVANT.xls" _
    , UpdateLinks:=3
    Ouverture du fichier avec mise à jour des liaisons externes/internes
    ??? pourquoi définir dossier courant et ne pas s'en servir ?
    Sheets(1).Copy After:=Workbooks(NomFichierWCJour).Sheets(1)
    Copier la 1re feuille du classeur qu'on vient d'ouvrir
    en 2me feuille du classeur (NomFichierWCJour)
    NomFichierWCJour doit être une variable globale initialisée dans une autre macro
    Windows("BASE AVANT .xls").Activate
    Active le fichier aouvert BASE AVANT
    Application.DisplayAlerts = False
    Masquer TOUS LES MESSAGES D'ALERTE D'EXCEL
    ActiveWindow.Close
    Fermer le fichier BASE AVANT, sans rien demander
    Si Excel détecte une erreur, tu n'es pas averti et tu n'auras aucune information quelque soit la manip, tant qu'Excel ne sera pas relancé
    Application.DisplayAlerts = True
    Relance la gestion des alerte, uniquement si le programme l'exécute
    Sheets(2).Name = "Base Avant "
    Renommer la 2me feuille du classeur (NomFichierWCJour)
    Range("A1").Select
    Selectionner A1 de feuille BASE AVANT du classeur (NomFichierWCJour)=> inutile
    NbrLigneBaseAvL1 = ActiveCell.SpecialCells(xlLastCell).Row
    détermine la dernière ligne non-vide
    à mon sens, UsedRange serait plus indiqué
    NbrLigneBaseAvL1 = UsedRange.SpecialCells(xlLastCell).Row
    Columns("C:S").Select
    Code issu du code automatique repris dans ligne suivante => ne sert à rien
    Range("C:S,W:AH").Select
    Selectionner les colonne de C à S et de W à AH
    Selection.Delete Shift:=xlToLeft
    Supprimer la sélection => une seule ligne :
    Range("C:S,W:AH").delete
    Columns("A:E").Select
    Selection.Columns.AutoFit
    Columns("A:E").Columns.AutoFit
    Ajustement largeur des colonnes A à E
    Rows("2:2").Select
    Sélectionner la ligne 2
    ActiveWindow.FreezePanes = True
    Figer les volets
    Range("A1:E1").Select
    Selection.AutoFilter
    Range("A1:E1").AutoFilter
    Mettre en place le filtre automatique
    Range("A1").Select
    Sélectionner A1
    Sheets(NomFeuilleDonneesRequi).Select
    'sélectionner la feuille NomFeuilleDonneesRequi (variable globale
    Range("A1").Select
    sert à rien
    NbrLigneRequi = ActiveCell.SpecialCells(xlLastCell).Row
    NbrLigneRequi = UsedRange.SpecialCells(xlLastCell).Row
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'Base Avant '!R2C1:R1000C5,3,FALSE)"
    coller la formule en G2 :=RechercheV(D2;'Base Avant '!$A$2:$E$1000;3;0)
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Base Avant '!R2C1:R1000C5,5,FALSE)"
    coller la formule en H2 :=RechercheV(D2;'Base Avant '!$A$2:$E$1000;5;0)
    Range("G2:H2").Select
    Selection.AutoFill Destination:=Range("G2:H" & NbrLigneRequi)
    copier G2H2 sur G2:H2 jusqu'à dernière ligne
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Type WC"
    Titre colonne G en G1
    With ActiveCell.Characters(Start:=1, Length:=7).Font
    .Name = "Arial"
    .FontStyle = "Gras"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Beuark !!!! mise en forme issue de macro apprentissage non épurée. Peut vraisemblablement être remplacée :
    Range("G1").Font.Bold = True
    Range("G1").Font.Size = 10
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "WC"
    With ActiveCell.Characters(Start:=1, Length:=2).Font
    .Name = "Arial"
    .FontStyle = "Gras"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Idem
    Range("A1:J1").Select
    Selection.AutoFilter
    Supprimer l'autofiltre qu'on mit avant et dont on ne s'est pas servit
    Selection.AutoFilter
    Remattre l'autofiltre sur A1:J1
    Range("G:G,H:H").EntireColumn.AutoFit
    ajuster les largeur de colonne
    Sheets(2).Select
    Retourner sur la 2me feuille
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    Protéger la feuille
    Range("A2").Select
    sélectionner A2 ???
    Sheets(3).Select
    Sélectionner 3me feuille
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    Protéger la feuille
    Range("A2").Select
    sélectionner A2
    End Sub
    OUF, on a fini
    J'ai commenté le code donné.
    Ce code est issu d'une macro apprentissage (j'espère )
    Comme j'aime bien critiquer, :
    Attention, ce qui suit n'est qu'une opinion personnelle, qui n'engage personne d'autre
    on l'a "enrichi" de quelques instructions, mais l'ensemble est assez anarchique
    Si on veut "faire du code de sorte éfficace et maintenable", il faut :
    - Comprendre ce qu'on fait : quel code utiliser, comment l'épurer, quels sont les avantages et inconvénients des instructions utilisées.
    C'est à ça que sert le forum. Mais pour ça, il ne faut pas hésiter à poser des questions, même si elles semblent "idiotes", "basiques"
    - Regrouper les instructions en fonction de leurs actions, au "bon endroit" :
    Dans la macro, il y a de la mise en forme et de la déclaration de filtre automatique, en plusieurs endroits, sans aucune raison.
    - limiter les risques d'erreurs utiliser des instructions comme Sheets(3) me gêne, surtout si le classeur peut être utiliser par d'autres personnes.
    - Limiter la portée des "objets" utilisés : Les instructions "Application." concerne Excel, pas seulement la feuille ou le classeur actif
    La macro utilise des variables globales qui sont initialisées ailleurs.
    En clair, fait un algorythme avant de faire du code

  3. #3
    Nouveau Candidat au Club
    Inscrit en
    août 2007
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2007
    Messages : 3
    Points : 1
    Points
    1
    Par défaut
    Merci beaucoup pour le commentaire du code, cela va me permettre de mieux comprendre le fonctionnement des différentes parties ainsi que les parties que je dois modifier.

    Pour ce qui est des formules de type RC, je ne savais pas qu'on pouvait les changer sans problème par des coordonnées de cellules

    Malheuresement non, ce n'est pas une macro d'apprentissage, mais une macro gérant Des réquisitions, des stocks et des temps de travail en entreprise.
    Elle a été réalisée par un stagiaire l'année dernière qui y a passé 6 mois.

    De mon côté je dois faire des regroupement de fichiers et quelques optimisations pour que l'ensemble soit plus facile à utiliser.

    Je n'avais jamais mis les pieds dans le vba ou même les maccros avant il y a 3 semaines, donc, je pense que j'aurai encore pas mal de questions à poser sur le forum.

    En tout cas merci encore pour cette réponse rapide et efficace

  4. #4
    Membre émérite
    Profil pro
    Inscrit en
    juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2007
    Messages : 2 130
    Points : 2 449
    Points
    2 449
    Par défaut
    Salut
    Le temps de faire la macro, et problème d'internet => tout perdu
    => commentaires et envoi
    Donc, macro un peu modifiée sur nouveau poste :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
     
    Sub Distrib_WC()
    'Déclarations ================================
    Dim Chem As String
    Dim NbrLigneBaseAvL1 As Long
    Dim NbrLigneRequi As Long
    'Copie ========================================
    Chem = "P:\###########\Base WC\ANALYSE DU MIX PAR FAMILLE DE WC\"
    'Chemin du fichier
    Workbooks.Open Filename:=Chem & "BASE AVANT.xls" _
    , UpdateLinks:=3
    'Ouverture fichier
    Sheets(1).Copy After:=Workbooks(NomFichierWCJour).Sheets(1)
    'Copier la feuille 1 derrière la feuille 1 du fichier Base Avant
    ActiveSheet.Name = "Base Avant"
    'renommer la copie
    Workbooks("BASE AVANT.xls").Close SaveChanges:=False
    'Fermer le fichier BASE AVANT sans sauvegarder les mise à jour liaison
    'On est sur la copie de la feuille exécutée précédemment
    'Travail sur la copie ==========================
    'Suppression données inutiles ------------------
    Range("C:S,W:AH").Delete Shift:=xlToLeft
    'Passage en mode autofiltre --------------------
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    'si on est en mode autofiltre, on le supprime
    Range("A1:E1").AutoFilter
    'mise en forme de la fenêtre -------------------
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    'Figer les volets
    Columns("A:E").AutoFit
    'ajuster la largeur des colonnes
    'Travail sur feuille NomFeuilleDonneesRequi =======================
    Sheets(NomFeuilleDonneesRequi).Activate
    NbrLigneRequi = UsedRange.SpecialCells(xlLastCell).Row
    'Dernière ligne
    'Titres ------------------------------------------------------------
    Range("G1").Formula = "Type WC"
    Range("G1").Formula = "Type WC"
    'Formules ----------------------------------------------------------
    Range("G2").FormulaLocal = "=RECHERCHEV(D2;'Base Avant'!$A$2:$E$1000;3;FAUX)"
    Range("H2").FormulaLocal = "=RECHERCHEV(D2;'Base Avant'!$A$2:$E$1000;5;FAUX)"
    Range("G2:H2").AutoFill Destination:=Range("G2:H" & NbrLigneRequi)
    'Mise en forme -----------------------------------------------------
    With Range("G1:H1").Font 'Mise en préfixe, si caractére de liaion ".' ou "!"
        .Name = "Arial"     'Police Arial
        .Bold = True        'Gras
        .Size = 10          'taille 10
    End With
    'Seules les caractéristiques qui changent sont à mettre
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
    'Désactivation du mode autofiltre s'il existe
    Range("A1:J1").AutoFilter
    'Autofiltre sur A1:J1
    Columns("G:H").AutoFit
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    Range("A2").Select
    Sheets(3).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    'protection de la feuille active et de la feuille index=3
    Sheets(3).Activate
    'Activation de la feuille n°3
    End Sub
    Devrait être légèrement plus facile à maintenir, mais : je l'ai pas testée, donc à vérifier (les formules par exemple)
    Comme certaines variables sont définies dans la macro, par habitude, je les ai déclarées. Mais si elles sont déclarées en global et utilisées ailleurs, il serait préférable de supprimer les déclarations de NbrLigneRequi et NbrLigneBaseAvL1.
    Par principe, et surtout par ce que ça m'aide, j'oblige toujours la déclaration des variables.

    Si questions, ne pas hésiter

    A+

    NB Stagiaire => macro apprentissage, sans comprendre réellement ce que fait le code ou, pas assez de temps (mais, ça n'arrive jamais en informatique) => code brut (mais c'est déjà pas si mal)

  5. #5
    Nouveau Candidat au Club
    Inscrit en
    août 2007
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2007
    Messages : 3
    Points : 1
    Points
    1
    Par défaut
    Salut

    Gorfael merci pour cette version modifiée , je testerai quand j'aurai récuperé une clé usb capable de rappatrier tous les fichiers de travail de l'intranet avant de me lancer dans une modification (normalement ce soir ou demain au plus tard.)

    Quelqu'un pourrait il me faire églament les commentaires sur cette partie de macro ?



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    Sub Recup_Requi_L1()
    '
    ' Recup_Requi_L1 Macro
    ' Macro enregistrée le 26/04/2006 
    '
        NomFichierWCJour = ActiveWorkbook.Name
        NomVehic = Sheets(1).Range("H8").Value
        ChDir _
            "P:\########\jit tool\Requisitions "
        Application.Dialogs(xlDialogOpen).Show
        NomFichierRequi = ActiveWorkbook.Name
        Sheets("Ligne1").Copy Before:=Workbooks( _
            NomFichierWCJour). _
            Sheets(2)
        Workbooks(NomFichierRequi).Close
        DateAnnee = InputBox("Veuillez saisir l'année des données de réquisition", "Année des données de réquisition?", "2006")
        DateMois = InputBox("Veuillez saisir le mois des données de réquisition", "Mois des données de réquisition?", "Janvier")
        DateMoisAnnee = DateMois + " " + DateAnnee
        DateDebutQuant = "01/01/" + DateAnnee
        NomFeuilleDonneesRequi = "Requisition " + NomVehic + " " + DateMoisAnnee
        Sheets(2).Name = NomFeuilleDonneesRequi
        ActiveSheet.Unprotect
        Columns("F:G").Select
        Selection.Cut
        Columns("K:K").Select
        Selection.Insert Shift:=xlToRight
        CoordMat_Requi = "='" + NomFeuilleDonneesRequi + "'!R2C2:R15000C8"
        CoordMat_Quant = "='" + NomFeuilleDonneesRequi + "'!R2C6:R15000C6"
        CoordMat_WC = "='" + NomFeuilleDonneesRequi + "'!R2C8:R15000C8"
        ActiveWorkbook.Names.Add Name:="Mat_Requi", RefersToR1C1:= _
            CoordMat_Requi
        ActiveWorkbook.Names.Add Name:="Mat_Quant", RefersToR1C1:= _
            CoordMat_Quant
        ActiveWorkbook.Names.Add Name:="Mat_WC", RefersToR1C1:= _
            CoordMat_WC
     
        CoordMat_Type_WC = "='" + NomFeuilleDonneesRequi + "'!R2C7:R15000C7"
        ActiveWorkbook.Names.Add Name:="Mat_Type_WC", RefersToR1C1:= _
            CoordMat_Type_WC
     
    End Sub

  6. #6
    Membre émérite
    Profil pro
    Inscrit en
    juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2007
    Messages : 2 130
    Points : 2 449
    Points
    2 449
    Par défaut
    Salut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
     
    Sub Recup_Requi_L1()
    'Initialisation des variables ===================
    NomFichierWCJour = ActiveWorkbook.Name
    'Nom du classeur actif
    NomVehic = Sheets(1).Range("H8").Value
    'Nom du véhicule
    'Modéle =========================================
    ChDir "P:\########\jit tool\Requisitions "
    'Répertoire courrant
    Application.Dialogs(xlDialogOpen).Show
    'Comme quand on clique sur l'icone "Ouvrir"
    'Comme tu n'as plus la main, on définit précédemment le dossier sur lequel on ouvres
    NomFichierRequi = ActiveWorkbook.Name
    'On stoque le nom du fichier qu'on vient d'ouvrir
    'Serait logique de tester qu'on en a ouvert un, en comparant les 2 nom de classeur
    Sheets("Ligne1").Copy Before:=Workbooks(NomFichierWCJour).Sheets(2)
    'Copie "Ligne1" en 2me feuille dans le classeur de départ
    Workbooks(NomFichierRequi).Close
    'Fermeture du classeur ouvert
    'Organisation classeur ============================
    DateAnnee = InputBox("Veuillez saisir l'année des données de réquisition", "Année des données de réquisition?", "2006")
    DateMois = InputBox("Veuillez saisir le mois des données de réquisition", "Mois des données de réquisition?", "Janvier")
    'demande année/mois par boîte de dialogue
    DateMoisAnnee = DateMois + " " + DateAnnee
    DateDebutQuant = "01/01/" + DateAnnee
    NomFeuilleDonneesRequi = "Requisition " + NomVehic + " " + DateMoisAnnee
    Sheets(2).Name = NomFeuilleDonneesRequi
    'Modification du nom de la feuille copiée
    ActiveSheet.Unprotect
    'Déprotection
    Columns("F:G").Select
    Selection.Cut
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight
    'Columns("F:G").Cut
    'Columns("K:K").Insert Shift:=xlToRight
    'Couper/Coller de FG Devant K
    'Définition des Noms ======================
    CoordMat_Requi = "='" + NomFeuilleDonneesRequi + "'!R2C2:R15000C8"
    CoordMat_Quant = "='" + NomFeuilleDonneesRequi + "'!R2C6:R15000C6"
    CoordMat_WC = "='" + NomFeuilleDonneesRequi + "'!R2C8:R15000C8"
    CoordMat_Type_WC = "='" + NomFeuilleDonneesRequi + "'!R2C7:R15000C7"
    'Composition des Formules de référence ---------------
    ActiveWorkbook.Names.Add Name:="Mat_Requi", RefersToR1C1:=CoordMat_Requi
    ActiveWorkbook.Names.Add Name:="Mat_Quant", RefersToR1C1:=CoordMat_Quant
    ActiveWorkbook.Names.Add Name:="Mat_WC", RefersToR1C1:=CoordMat_WC
    ActiveWorkbook.Names.Add Name:="Mat_Type_WC", RefersToR1C1:=CoordMat_Type_WC
    'Définitions des noms à l'aide des formules
    End Sub
    Testes cette macro
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    Sub test()
    Dim X As Date
    X = Application.InputBox("Texte", "Titre", "01/2006", , , , , 1)
    MsgBox ("Date Saisie : " & X)
    End Sub
    A+

Discussions similaires

  1. débutant demande conseil sur sa macro
    Par magicfly dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 02/03/2011, 19h58
  2. Demande d’information sur les macros
    Par bilred dans le forum InfoPath
    Réponses: 2
    Dernier message: 25/09/2009, 22h20
  3. Petite aide sur cette macro de contrôle
    Par roidurif dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 24/04/2009, 16h38
  4. [VBA] Excell : demande d'aide pour une macro
    Par Fealendril dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 11/01/2006, 17h28
  5. Aide sur les macros Excel pour recopie auto de données
    Par nicoduhavre dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 15/11/2005, 09h38

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo