Etendre une macro à une colonne

[yannlion]

Bonjour,

Après avoir consulté et trouvé grâce au forum la solution à mon problème, je me tourne à nouveau vers vous pour alléger ma macro.

En fait j'ai des noms d'équipe en colonne B dont les drapeaux (images) se trouvent dans mon dossier.

Je viens de faire une macro permettant d'insérer le drapeau correspondant en colonne A7 à partir de la cellule B7.

Mais est-il possible de faire une unique formule pour automatiser la macro de B7 à B67 vers A7 à A67 ?

J'espère avoir été à peu près clair !



Voici ma macro :

Sub Macro1()

GA1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B7") & ".jpg"
If Dir(GA1) <> "" Then
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B7") & ".jpg")
pic.Top = Cells(7, 1).Top
pic.Left = Cells(7, 1).Left
pic.Width = Cells(7, 1).Width
pic.Height = Cells(7, 1).Height
End If
End Sub



Sinon je peux récrire la macro 60 fois ...

Merci d'avance,
Yannlion

 

[wilfried_42]

Re : Etendre une macro à une colonne

Bonjour et bienvenue sur le forum

applique les modifications en rouge (si j'ai tout compris)

Sub Macro1()
[COLOR="Red"]Dim i as integer
For i = 7 to 67[/COLOR]
GA1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B"[COLOR="red"] & i[/COLOR]) & ".jpg"
   If Dir(GA1) <> "" Then
      Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B"[COLOR="red"] & i[/COLOR]) & ".jpg")
      pic.Top = Cells([COLOR="red"]i[/COLOR], 1).Top
      pic.Left = Cells([COLOR="red"]i[/COLOR], 1).Left
      pic.Width = Cells([COLOR="red"]i[/COLOR], 1).Width
      pic.Height = Cells([COLOR="red"]i[/COLOR], 1).Height
   End If
[COLOR="red"]Next i[/COLOR]
End Sub

Edit : Bonjour bhbh

 

[Cousinhub]

Re : Etendre une macro à une colonne

Bonjour,
non testé

Essaie le code suivant :

Sub Macro1()
For Each cel In Range("A7:A67")
    GA1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & cel.Offset(, 1) & ".jpg"
    If Dir(GA1) <> "" Then
    Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & cel.Offset(, 1) & ".jpg")
    With pic
        .Top = Cells(cel.Row, 1).Top
        .Left = Cells(cel.Row, 1).Left
        .Width = Cells(cel.Row, 1).Width
        .Height = Cells(cel.Row, 1).Height
    End With
End If
End Sub

Edit : Bonjour Wilfried

 

[yannlion]

Re : Etendre une macro à une colonne

Tout simplement fabuleux !

Si simple ... mais si dur à trouver !
Ça fait 3 jours que je suis dessus ... mais là chapeau.

Mais Wilfried c'est sûr, Plus j'apprends, plus je sais....... plus je sais que je ne sais rien !

Je viens de "découvrir" le vba et c'est vraiment puissant !

Merci encore !

 

[yannlion]

Re : Etendre une macro à une colonne

re bonjour,

Même question que ci dessus mais pour 2 colonnes différentes ?

Dois-je faire 2 macro différentes ?

Exemple :

si les cellules de B7 à B36 ont leur image en colonne A
et les cellules de F7 à F36 en colonne G7 à G36 ???

J'ai rajouté un module me supprimant les images afin de ne pas les superposer !

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = (2;6) Then
Call [Macro1]
End If
End Sub

Sub Macro1()
Dim img As Object
For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
img.Delete

Next
Dim i As Integer
For i = 7 To 36
GA1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B" & i) & ".jpg"
GA2 = "C:\Documents and Settings\Yannick\Bureau\euro\" & Range("F" & i) & ".jpg"
If Dir(GA1) <> "" Then
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & Range("B" & i) & ".jpg")
pic.Top = Cells(i, 1).Top
pic.Left = Cells(i, 1).Left
pic.Width = Cells(i, 1).Width
pic.Height = Cells(i, 1).Height
End If
If Dir(GA2) <> "" Then
Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & Range("F" & i) & ".jpg")
pic.Top = Cells(i, 7).Top
pic.Left = Cells(i, 7).Left
pic.Width = Cells(i, 7).Width
pic.Height = Cells(i, 7).Height
End If
Next i
End Sub

 

[Cousinhub]

Re : Etendre une macro à une colonne

Re-,
avec mon code, toujours non testé (j'ai pas les images...)

Modifie comme ceci, le principe, on détermine un ofset en fonction de la colonne
Si en colonne A, l'ofset est de 1 sinon, de -1

Sub Macro1()
For Each cel In Range("A7:A67,G7:G36")
    [COLOR="Red"]ofset[/COLOR] = IIf(cel.Column = 1, 1, -1)
    GA1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & cel.Offset(, [COLOR="Red"]ofset[/COLOR]) & ".jpg"
    If Dir(GA1) <> "" Then
    Set pic = ActiveSheet.Pictures.Insert("C:\Documents and Settings\Yannick\Bureau\euro\" & cel.Offset(, [COLOR="Red"]ofset[/COLOR]) & ".jpg")
    With pic
        .Top = cel.Offset(, [COLOR="Red"]ofset[/COLOR]).Top
        .Left = cel.Offset(, [COLOR="Red"]ofset[/COLOR]).Left
        .Width = cel.Offset(, [COLOR="Red"]ofset[/COLOR]).Width
        .Height = cel.Offset(, [COLOR="Red"]ofset[/COLOR]).Height
    End With
End If
Next cel
End Sub

Si cela fonctionne....

 

[wilfried_42]

Re : Etendre une macro à une colonne

re:

en reprenant la boucle de bhbh que je salue

si les cellules de B7 à B36 ont leur image en colonne A
et les cellules de F7 à F36 en colonne G7 à G36 ???

Dim cel as range, ga1 as string

Sub macro1()
For each cel in range("A7:A36,F7:F36")
    ga1 = "C:\Documents and Settings\Yannick\Bureau\euro\" & cel.Offset(, 1) & ".jpg"
    if dir(ga1)<>"" then 
       Set pic = ActiveSheet.Pictures.Insert(ga1)
       pic.top = cel.top
       pic.left = cel.left
       pic.height = cel.height
       pic.width = cel.width
    end if
next
end sub