Macro

Résolu
Gwen59000 Messages postés 52 Statut Membre -  
TiboleParano Messages postés 585 Statut Membre -
Bonjour,

J'ai créé une macro que je dois appliquer à chaque cellule de la même colonne, k776 à k1006.
Je fais actuellement la manip à la main cellule par cellule. Pourriez vous m'expliquer ce que je dois ajouter dans cette macro pour qu'elle s'execute d'elle même à la cellule suivante et ce de k776 à k1006.

Merci d'avance,
Configuration: Windows XP Internet Explorer 7.0

9 réponses

  1. Pimp92a Messages postés 442 Statut Membre 44
     
    Bonjour,

    Peux-tu envoyer le code de ta macro
    1
  2. Gwen59000 Messages postés 52 Statut Membre
     
    La voici,
    Les cellules de la colonne k dans mon classeur principal contiennent un lien hypertexte qui me conduit directement à un autre classeur excel plus détaillé. Chaque cellule correspond à un fichier excel. C'est une fois avoir cliqué sur ce lien et donc ouvert le classeur excel correspondant que j'éxécute la macro suivante puis je fais de même pour la cellule suivante et la suivante...

    Sub MODIFEXP()
    '
    ' MODIFEXP Macro
    ' Macro enregistrée le 28/12/2009 par
    '
    ' Touche de raccourci du clavier: Ctrl+Maj+M
    '
    Range("C27:D38").Select
    Selection.Copy
    Range("C6:D17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("H27:I38").Select
    Selection.Copy
    Range("H6:I17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G22:U23").Select
    Selection.Copy
    Range("J1:U2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G22:U23").Select
    Windows("201.xls").Activate
    Range("B4:U5").Select
    Selection.Copy
    Windows(2).Activate
    Range("B4:U5").Select
    ActiveSheet.Paste
    Windows("201.xls").Activate
    Application.CutCopyMode = False
    Range("E6").Select
    Selection.Copy
    Windows(2).Activate
    Range("E6").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("J6").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("O6").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("E6").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("E6:F6"), Type:=xlFillDefault
    Range("E6:F6").Select
    Selection.AutoFill Destination:=Range("E6:F17"), Type:=xlFillDefault
    Range("E6:F17").Select
    Range("J6").Select
    Selection.AutoFill Destination:=Range("J6:K6"), Type:=xlFillDefault
    Range("J6:K6").Select
    Selection.AutoFill Destination:=Range("J6:K17"), Type:=xlFillDefault
    Range("J6:K17").Select
    Range("O6").Select
    Selection.AutoFill Destination:=Range("O6:P6"), Type:=xlFillDefault
    Range("O6:P6").Select
    Selection.AutoFill Destination:=Range("O6:P17"), Type:=xlFillDefault
    Range("O6:P17").Select
    Range("T6").Select
    Selection.AutoFill Destination:=Range("T6:U6"), Type:=xlFillDefault
    Range("T6:U6").Select
    Selection.AutoFill Destination:=Range("T6:U17"), Type:=xlFillDefault
    Range("T6:U17").Select
    Windows("201.xls").Activate
    Range("E18").Select
    Selection.Copy
    Windows(2).Activate
    Range("E18").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("J18").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("O18").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("T18").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("E18").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("E18:F18"), Type:=xlFillDefault
    Range("E18:F18").Select
    Range("J18").Select
    Selection.AutoFill Destination:=Range("J18:K18"), Type:=xlFillDefault
    Range("J18:K18").Select
    Range("O18").Select
    Selection.AutoFill Destination:=Range("O18:P18"), Type:=xlFillDefault
    Range("O18:P18").Select
    Range("T18").Select
    Selection.AutoFill Destination:=Range("T18:U18"), Type:=xlFillDefault
    Range("T18:U18").Select
    Range("A22:U39").Select
    Selection.ClearContents
    With Selection
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Interior.ColorIndex = 15
    Rows("3:3").Select
    Selection.RowHeight = 100
    Range("A3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Range("A1:A2").Select
    With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.787401575)
    .RightMargin = Application.InchesToPoints(0.787401575)
    .TopMargin = Application.InchesToPoints(0.984251969)
    .BottomMargin = Application.InchesToPoints(0.984251969)
    .HeaderMargin = Application.InchesToPoints(0.4921259845)
    .FooterMargin = Application.InchesToPoints(0.4921259845)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 100
    .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 4
    Range("A41:U41").Select
    Selection.AutoFill Destination:=Range("A32:U41"), Type:=xlFillDefault
    Range("A32:U41").Select
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("F18").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    Range("K18,P6:P18").Select
    Range("P6").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Range("T6:T18").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    Range("A1:A2").Select

    ActiveWorkbook.Save
    ActiveWorkbook.Close
    End Sub
    0
  3. Pimp92a Messages postés 442 Statut Membre 44
     
    Ok jtu dois pouvoir faire une boucle sur les cellules en fonction d'un critère
    0
  4. TiboleParano Messages postés 585 Statut Membre 61
     
    tu rajoutes ceci je crois:
    x = 776
    Do While x<=1006
    
    GrandX_mystère_1
    
    [ton code maccro]
    
    GrandX_mystère_2
    
    x = x + 1
    Loop
    


    Voilaà, le code fera une bouclera entre Do while ... et Loop, il repetera ton code (1006-776)fois
    Le problème c'est que dans tes cellules tu dois ouvrir le lien du nouveau classeur, et appliquer la maccro sur ce classeur, et revenir en reprenant le focus sur le classeur principal, il va falloir chercher encor un peu
    Voici les GrandXs:
    GrandX_mystère_1: doit selectionner la cellule (x,11) (11 correspond à k); ouvrir le lien qu'il contient; définir le focus sur la nouvelle fenêtre
    GrandX_mystère_2: ta maccro quitte le sous-classeur toute seule si je me trompe pas. Reprise du focus sur le classeur principal pour recomencer la prochaine boucle ..
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. TiboleParano Messages postés 585 Statut Membre 61
     
    Sinon jvoudrai que tu test quelque chose: tu enregistre une maccro ou tu ne fais que cliquer sur un lien, puis tu arretes l'enregistrement, et tu copie le code qu'il te met
    Sinon j'ai trouvé la fonction FollowHyperLink
    de la forme:
    [application.]FollowHyperlink address, [subaddress], [newwindow], [addhistory], [extrainfo], [method], [headerinfo]
    

    qui se taperait donc dans ton cas:
    application.FollowHyperlink Cells(x,11)
    (je pense que le "application." est facultatif)
    Cells(x,11) sélectionne la case k776~1006
    fais un test pour voir si sa tlance kkchose ...
    0
  7. Gwen59000 Messages postés 52 Statut Membre
     
    J'ai essayé ceci mais message d'erreur pour la ligne "Range..." Je fais mes débuts en macro, ne pas se moquer !
    Une explication ?

    Sub essai()
    '
    ' essai Macro
    ' Macro enregistrée le 29/12/2009 par
    '

    '
    For i = 776 To 1006

    Range("Ki+1").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Application.Run "'202.xls'!MODIFEXP"(ma macro)
    Windows("RECAPITULATIF CLIENTS.xls").Activate

    Next i
    End Sub
    0
  8. TiboleParano Messages postés 585 Statut Membre 61
     
    alors pour la ligne range l'erreur est "Ki+1", c'est évident qu'il ne le reconnait pas, il ne remplace pas i par sa valeur et l'incremente encore moins =/
    d'ailleurs pourquoi incrementes-tu ?
    Sinon je vois 2solutions pour remplacer ton range:
    la solution que je t'avais proposé:
    range(i,11)
    

    avec i en numéro de ligné
    et 11 en numéro de colonne (11=K)
    ou, avec ta méthode:
    range("K" & i)
    ou
    range("K" & (i+1) )
    

    NB: le & sert à concatener: en gros il colle la valeur de i après K, genre i=805: "K" & i => "K805"
    et j'ai mis 2codes à savoir sans et avec incrémentation, choisis celui que tu veux
    PS: moi aussi je suis nouveau en macro, sa fait 4jours que jm'y coltine pour ltaff ^^ et bien joué, jvois que t'as trouvé les morceaux de code qui manque, tu m'impressiones :)
    0
  9. Gwen59000 Messages postés 52 Statut Membre
     
    Merci ça fonctionne. Comment en sais tu autant en 4 jours sur la macro ?????
    0
  10. TiboleParano Messages postés 585 Statut Membre 61
     
    J'avoue avoir en partie menti, sa fait des années que j'aprends différents languages C,html,php ... donc même avec seulement 4jours d'access, jretiens facilement, surtout les trucs basiques svt nécessaires: range pour selectionner une cellule, do while pour une boucle, & pour concatener
    après jsuis paumé sur les plus grosses fonctions, c'est pour sa que tu m'as épaté quand jt'ai expliqué ce qu'il fallait (GrandX_mystère :P) et que t'as trouvé de suite les fonctions, et adaptée
    et franchement si ta fonction marche déjà impec, je tire mon chapeau, je suis habitué aux problèmes en cascade en prog, jcafouille un peu trop parfois ^^
    sur ce jpense que jraconte ma vie, donc j'arrete de m'afficher sur ce mot: Topinambour
    ;) Have fun
    0