Discussion :

[GM2905]

Bonjour à tous.

Étant nul en macros, je sollicite votre aide pour me faciliter une action répétitive.
J'ai parcouru le web et testé plusieurs macros trouvées mais je ne trouve pas mon bonheur.

Exposé du problème:
J'ai un tableau excel 2010 qui comporte 9 plages de cellules fusionnées où je dois insérer un jpg différent dans chaque plage.
Les images sont dans un dossier sur mon serveur.
Elles doivent être ajustées/redimensionnées aux dimensions des # plages.
Il faut donc que je puisses dire où je veux aller chercher le jpg et choisir la plage voulue pour mettre l'image.
Les plages sont définies comme suit:
Plage1= A6:N16
Plage2= M33:AB47
Plage3= C74:K84
Plage4= L74:T84
Plage5= U74:AC84
Plage6= B20:K30
Plage7= AC51:AL61
Plage8= B51:K61
Plage9= AC21:AL30

J'ai essayé l'enregistreur de macro mais comme je l'ai dit je suis trop nul et je n'y arrives pas.

Si une bonne âme pouvait m'aider, je lui en serais très reconnaissant.
Merci d'avance à celui qui s’intéressera à ce sujet.
Cordialement, Gilles.

[Philippe Tulliez]

Bonjour,
Ta question regroupe plusieurs sujets et devrait faire l'objet de plusieurs discussions

Étant nul en macros, je sollicite votre aide pour me faciliter une action répétitive.

Dire que l'on est nul, n'est pas très constructif.
Pour t'aider, il faudrait d'abord savoir si tu souhaites réellement t'investir car faire un simple Copier/Coller d'un code que l'on "pondrait" pour toi n'a rien de constructif et ne répond pas à 'idée que je me fais d'un forum d'entraide.

J'ai essayé l'enregistreur de macro mais comme je l'ai dit je suis trop nul et je n'y arrives pas.

L'utilisation de l'enregistreur de macros ne demande pas de connaissance en VBA. Par contre modifié le code produit oui.

Les images sont dans un dossier sur mon serveur.
Il faut donc que je puisses dire où je veux aller chercher le jpg

Toutes les boites de dialogues que l'on utilise dans Excel sont programmables en VBA et donc y compris la sélection d'un dossier à lire
faq sur les boîtes de dialogues intégrées
et surtout
Comment utiliser la boîte de dialogue FileDialog ?

Voici une fonction que j'ai écrite et qui renvoie le nom du dossier sélectionné

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function GetFolder(Optional StrPath As String) As String
  ' Philippe Tulliez (http://www.magicoffice.be/)
  ' Argument
  ' [strPath]  Nom du répertoire par défaut si pas rempli
  Dim SelectedFolder As String
  If Len(StrPath) = 0 Then StrPath = Application.ActiveWorkbook.Path & "\"
  If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\"
  With Application.FileDialog(msoFileDialogFolderPicker)
  .Title = "MagicOffice - Selection d'un répertoire"
  .InitialFileName = StrPath
  .Show
   Select Case .SelectedItems.count
     Case Is > 0: SelectedFolder = .SelectedItems(1)
     Case Else: SelectedFolder = ""
   End Select
  End With
  GetFolder = SelectedFolder
End Function

Exemple de son utilisation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub TestGetFolder()
  Dim Folder As String
  Folder = GetFolder()
  If Len(Folder) Then
     MsgBox "Vous avez sélectionné le répertoire : " & vbCrLf & Folder
    Else
     MsgBox "Vous n'avez rien sélectionné"
  End If
End Sub

[patricktoulon]

re
bon soir Philippe et GM2905

et après Philippe j'ajoute le placement
il y a 2 methode que j'apelle "en amont" "en aval"

en amont consiste a calculer les ratio image/plages AVANT!! de toucher a l'image car en effet il faut calculer le left,top,width,height quand on ne touche pas a l'image d'abords

méthode donc "en amont"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
[
Sub test()
    Dim plage As Range
    Set plage = Range("B4:C14")
    'Set plage = Range("f3:h9")
         pos = DimAndCoordonnees(plage, ActiveSheet.Pictures("pinguouins"))
    With ActiveSheet.Pictures("pinguouins")
       .Width = pos(2)
        .Height = pos(3)
        .Left = pos(0)
        .Top = pos(1)
    '.Placement = 1
 End With
End Sub
 
'la fonction calcule sans toucher a la shape
Function DimAndCoordonnees(RnG As Range, ObJ As Object, Optional MinSpace As Double = 2)
    Dim nW#, nH#, wR#, hR#, newT#, newL#, nL, nT#
    ratio = ObJ.Width / ObJ.Height     ' ration de l'object
    wR = RnG.Width       ' width  range
    hR = RnG.Height      ' height range
    If (wR / hR < ratio) Then
        nW = wR - MinSpace
        nH = nW / ratio
    Else
        nH = hR - (MinSpace / ratio)
        nW = nH * ratio
    End If
      nL = RnG.Left + ((wR - nW) / 2)
    nT = RnG.Top + ((hR - nH) / 2)
   DimAndCoordonnees = Array(nL, nT, nW, nH)
End Function

et la méthode "en aval" donc après avoir réduit ou agrandi l'image a la plage on agit donc directement sur l'object
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton1_Click()
Dim plage As Range
Set plage = Range("B4:C14")
place_l_image_dans plage, ActiveSheet.Pictures("pinguouins")
End Sub
'
'la sub calcule en touchant a la shape
Sub place_l_image_dans(RnG As Range, Shp As Picture)
      With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        w = RnG.Width       ' width  range
        h = RnG.Height      ' height range
        If (w / h < ratio) Then
            .Width = w - 2
        Else
            .Height = h - (2 / ratio)
        End If
        .Left = RnG.Left + ((RnG.Width - .Width) / 2)
        .Top = RnG.Top + ((RnG.Height - .Height) / 2)
        .Placement = 1
    End With
End Sub