execution differents macro pour differentes feuils d'un classeur excel

Question

Bonjour, 

j'ai un classeur Excel qui contient plusieurs Feuils , Feuil1 execute macro1, Feuil2 execute macro2, .....esc 

c'est ce dont j'ai besoin. comment je pourais le faire?

mirage23 · Answer

en fait, c'est un macro qui importe des données provenant des fichiers partagés sous le reseau, alors la Feuil1 doit contenir les données du fichier 1, feuil 2 doit contenir les données du fihier 2, ...esc comme le chemin vers ces fichiers est different donc le macro change d'une feuil a l'autre , c'est possible?

ucfoutu · Answer

c'est un macro qui importe des données provenant des fichiers partagés
montre donc ce code d'importation (pour une des feuilles)

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

mirage23 · Answer

'Variable utilisable dans tout les codes
Public Next_Scan As Date

'Arret du Timer d'import ficher
Sub Stop_Import()
  On Error Resume Next
  Application.OnTime Next_Scan, "Import_Fichier", , False
End Sub

Sub Import_Fichier()
  Dim Fichier, Fichier_Ext, Repertoire, Chemin, Chemin_Complet
  
  'fige ecran
  Application.ScreenUpdating = False
  
  'Nom du fichier fonction de la date ex a20121211
  Fichier = "a" & Format(Date, "yyyymmdd")
  'Nom de fichier avec extention: .TXT pour ficher texte
  'correspondant aux nom de fichier attendu
  Fichier_Ext = "\a" & Format(Date, "yyyymmdd") & ".TXT"
  'correspondant aux nom de repertoire attendu
  Repertoire = "\données"
  'A adapter a votre utilisation
  Chemin = "\xxx.xx.xxx.xx"
  'Ecriture du chemin complet pour acceder au ficher attendu
  Chemin_Complet = Chemin & Repertoire & Fichier_Ext
  
  Worksheets("Affichage").Activate
    'Efface le contenu de toutes les cellules de l'onglet actif
    Cells.ClearContents
    
    'Importation du fichier texte a afficher, premiere cellule a remplir: A2
    'la base du code est obtenu avec l'enregistreur de macro et travaile en fonction
    'du besoin: noms de ficher et repertoire changeant en fonction de la date
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Chemin_Complet, Destination:= _
        Range("$A$2"))
        .Name = Fichier
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    'Selection Donnees importees
    Range("A2:AM8643").Select
    'RAZ tri
    ActiveWorkbook.Worksheets("Affichage").Sort.SortFields.Clear
    'Selection tri cle A2 descendant
    ActiveWorkbook.Worksheets("Affichage").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    'Tri Donnees
    With ActiveWorkbook.Worksheets("Affichage").Sort
        .SetRange Range("A3:AM250000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'positionne sur cellule A1
    Range("A1").Select

    'Parametrage interval temps import: ici 3 secondes
    Next_Scan = Now() + TimeValue("00:00:01")
    Application.OnTime Next_Scan, "Import_Fichier"
        
End Sub

mirage23 · Answer

le macro pourait etre le meme pour les fauils , seule chose qui change c'est soit l'adresse ip relative au chemin du fichier partagé, soit le nom ou le format des fichiers partagés...

Execution differents macro pour differentes feuils d'un classeur excel

4 réponses

Votre réponse

Discussions similaires