Macro Résolu

Question

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,

Pimp92a · Answer

Bonjour,

Peux-tu envoyer le code de ta macro

Gwen59000 · Answer

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

Pimp92a · Answer

Ok jtu dois pouvoir faire une boucle sur les cellules en fonction d'un critère

TiboleParano · Answer

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 ..

TiboleParano · Answer

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 ...

Gwen59000 · Answer

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

TiboleParano · Answer

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 :)

Gwen59000 · Answer

Merci ça fonctionne. Comment en sais tu autant en 4 jours sur la macro ?????

TiboleParano · Answer

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

Macro

9 réponses

Discussions similaires

Newsletters