XL 2016 Centrer Images

[halecs93]

Bonjour,

J'ai un fichier excel qui me permet de générer des grilles d'accords pour la guitare. Il se base sur des images stockées en feuil2.

Mon code VBA me permet d'aller chercher des accords sur cette feuille pour les coller en feuil1.

Souci, je ne m'en sors pas pour centrer horizontalement les images trouvées et collées.

Sui quelqu'un a une solution... je suis preneur.

Merci tout le monde

 

[halecs93]

intégré dans la sub modifié, par contre ta sub tu peux la mettre directement dans le module et non dans la feuille :

Sub InsérerImagesModifié()
    Dim ws As Worksheet
    Dim wsImages As Worksheet
    Dim i As Integer, j As Integer
 
    ' Définir la feuille de calcul à utiliser
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacez "Feuil1" par le nom de votre feuille
    Set wsImages = ThisWorkbook.Sheets("Feuil2") ' Remplacez "Feuil2" par le nom de la feuille contenant les images
   ws.Select
 
    ' Parcours des lignes avec les noms de notes de musique
    For i = 5 To 13 Step 2 ' Lignes B5, B7, B9, B11, B13
        For j = 2 To 8 ' Colonnes B à H
            Dim nomImage As String
            nomImage = ws.Cells(i, j).Value
         
            ' Chercher l'image correspondante dans la feuille "Feuil2"
            Dim imgShape As Shape
            On Error Resume Next
            Set imgShape = wsImages.Shapes(nomImage)
            On Error GoTo 0
         
            ' Si l'image est trouvée, copier et coller dans la feuille "Feuil1"
            If Not imgShape Is Nothing Then
                imgShape.Copy
                ws.Paste Destination:=ws.Cells(i + 1, j)
                With Selection.ShapeRange
                    .Left = ws.Cells(i + 1, j).Left + (ws.Cells(i + 1, j).Width - .Width) / 2
                    .Top = ws.Cells(i + 1, j).Top + (ws.Cells(i + 1, j).Height - .Height) / 2
                End With
                Application.Goto ws.Cells(i + 1, j)
'                Application.CutCopyMode = True
            End If
        Next j
    Next i
End Sub

Merci beaucoup... mais je ne comprends toujours pas pourquoi je rencontre cette erreur 400

 

[halecs93]

Merci beaucoup... mais je ne comprends toujours pas pourquoi je rencontre cette erreur 400

Merci... j'ai mis les codes en module, en effet.... et je reçois une erreur 1004

 

[patricktoulon]

Bonjour
centrer et redimentionner(si besoin une shape ou une image dans un range
il faudrait un peu se servir du moteur de recherche

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image) - Mises à jour

excel-downloads.com

 

[RyuAutodidacte]

j'ai testé le code de @fanch55 et le mien et je n'ai aucune erreur
Il faudrait que tu nous donnes toutes les conditions qd l'erreur se produit
supp : cc @patricktoulon

 

[RyuAutodidacte]

@halecs93, je n'ai pas de problème non plus avec le code de @Dranreb

 

[halecs93]

@halecs93, je n'ai pas de problème non plus avec le code de @Dranreb

Curieux... je reteste tout ceci demain. Encore merci

 

[halecs93]

Bonjour
centrer et redimentionner(si besoin une shape ou une image dans un range
il faudrait un peu se servir du moteur de recherche

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image) - Mises à jour

excel-downloads.com

Merci... mais ça n'a pas grand chose à voir malgré tout. Et des recherches, j'en ai fait avant de poster ma problématique ici. Merci

 

[halecs93]

Re...

à n'y rien comprendre... aujourd'hui, autre message d'erreur... quelqu'un aurait une idée de la raison ?

20 images copiées puis collées...et le message est apparu...

 

[patricktoulon]

re bonjour juste une question
ton souhait c'est bien de copier les images de la feuille2 vers la feuille1 c'est bien ça

 

[fanch55]

Salut, peux-tu joindre le classeur qui a provoqué l'erreur décrite ?

 

[halecs93]

Salut, peux-tu joindre le classeur qui a provoqué l'erreur décrite ?

Naturellement, le voici

 

[fanch55]

Chez moi, le classeur fonctionne correctement .
Peut-être un problème de mémoire, code modifié au cas où :

Sub InsérerImagesModifié()
    Dim ws As Worksheet
    Dim wsImages As Worksheet
    Dim i As Integer, j As Integer
    EffacerImages
    
    ' Définir la feuille de calcul à utiliser
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacez "Feuil1" par le nom de votre feuille
    Set wsImages = ThisWorkbook.Sheets("Feuil2") ' Remplacez "Feuil2" par le nom de la feuille contenant les images
    
    ' Parcours des lignes avec les noms de notes de musique
    For i = 5 To 13 Step 2 ' Lignes B5, B7, B9, B11, B13
        For j = 2 To 8 ' Colonnes B à H
            Dim nomImage As String
            nomImage = ws.Cells(i, j).Value
            
            ' Chercher l'image correspondante dans la feuille "Feuil2"
            Dim imgShape As Shape, Target As Range
            On Error Resume Next
                Set imgShape = wsImages.Shapes(nomImage)
            On Error GoTo 0
            
            ' Si l'image est trouvée, copier et coller dans la feuille "Feuil1"
            If Not imgShape Is Nothing Then
                imgShape.Copy
                    Set Target = ws.Cells(i + 1, j)
                        ws.Paste Destination:=Target
                        With ws.Shapes(ws.Shapes.Count)
                            .Left = Target.Left + (Target.Width - .Width) / 2
                            .Top = Target.Top + (Target.Height - .Height) / 2
                        End With
                    Set Target = Nothing
                    Application.CutCopyMode = False
                Set imgShape = Nothing
            End If
        Next j
    Next i
    
    Set wsImages = Nothing
    ws.Activate: ws.Cells(i, j).Select
    Set ws = Nothing
End Sub

 

[halecs93]

Chez moi, le classeur fonctionne correctement .
Peut-être un problème de mémoire, code modifié au cas où :

Sub InsérerImagesModifié()
    Dim ws As Worksheet
    Dim wsImages As Worksheet
    Dim i As Integer, j As Integer
    EffacerImages
  
    ' Définir la feuille de calcul à utiliser
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacez "Feuil1" par le nom de votre feuille
    Set wsImages = ThisWorkbook.Sheets("Feuil2") ' Remplacez "Feuil2" par le nom de la feuille contenant les images
  
    ' Parcours des lignes avec les noms de notes de musique
    For i = 5 To 13 Step 2 ' Lignes B5, B7, B9, B11, B13
        For j = 2 To 8 ' Colonnes B à H
            Dim nomImage As String
            nomImage = ws.Cells(i, j).Value
          
            ' Chercher l'image correspondante dans la feuille "Feuil2"
            Dim imgShape As Shape, Target As Range
            On Error Resume Next
                Set imgShape = wsImages.Shapes(nomImage)
            On Error GoTo 0
          
            ' Si l'image est trouvée, copier et coller dans la feuille "Feuil1"
            If Not imgShape Is Nothing Then
                imgShape.Copy
                    Set Target = ws.Cells(i + 1, j)
                        ws.Paste Destination:=Target
                        With ws.Shapes(ws.Shapes.Count)
                            .Left = Target.Left + (Target.Width - .Width) / 2
                            .Top = Target.Top + (Target.Height - .Height) / 2
                        End With
                    Set Target = Nothing
                    Application.CutCopyMode = False
                Set imgShape = Nothing
            End If
        Next j
    Next i
  
    Set wsImages = Nothing
    ws.Activate: ws.Cells(i, j).Select
    Set ws = Nothing
End Sub

Merci.... ça semble fonctionner.... mais aléatoirement. Sans doute en effet une question de mémoire...

 

[TooFatBoy]

Bonjour,

J'ai une question concernant la macro proposée : pourquoi mettre les Dim dans les boucles i et j ?

 

[fanch55]

Bonjour,

J'ai une question concernant la macro proposée : pourquoi mettre les Dim dans les boucles i et j ?

Académiquement parlant comme en Fortran ou en Cobol, on devrait les mettre en début de sub ou fonction .
En VB, ils ne sont honorés qu'au lancement de la sub et peuvent être déclarés n'importe où avant d'être utilisés ce qui peut induire une déclaration "mal placée" ou à un endroit qui en a besoin .... ( surtout pour la lecture du code)