Discussion :

[poruss]

Bonjour,

Je viens vers vous car je réalise pour mon travail une macro qui va me permettre d’éditer l'intégralité d'un dossier.

Pour cela à un moment donné, je demande à ma macro d’insérer une nouvelle feuille dans mon classeur puis de retrouver toutes les photos d'un dossier défini et de les insérer.
Le problème, je suis trop gourmand, à l'insertion je souhaite que la photo soit positionnée en cellule A2 et que sa taille ne dépasse pas la taille de la feuille, par ailleurs, chaque page aura 2 photos...

Pour cela j'ai fait ceci.

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
Dim DOSSIER_PHOTO As String, PHOTO As String
Dim i As Integer
Dim POS_INIT As Variant, DIM_IMG As Variant
 
 
DOSSIER_PHOTO = "\\EMPLACEMENT RESEAU ... \04 - PHOTO\" & DOSSIER & "\"
PHOTO = Dir(DOSSIER_PHOTO)
POS_INIT = 2
DIM_IMG = 24
 
'    Do While PHOTO <> ""
'    '    i = i + 1
'    Sheets("Feuil4").Range("L" & i) = PHOTO
'    Sheets("Feuil4").Range("A" & POS_INIT).Select
'    ActiveSheet.Pictures.Insert(DOSSIER_PHOTO & PHOTO).Select
'    Selection.ShapeRange.LockAspectRatio = msoFalse
'    Selection.ShapeRange.Height = Range("A" & POS_INIT & ":H" & DIM_IMG).Height
'    Selection.ShapeRange.Width = Range("A" & POS_INIT & ":H" & DIM_IMG).Width
'    POS_INIT = POS_INIT + 25
'    DIM_IMG = DIM_IMG + 25
'    PHOTO = Dir
'    Loop

Sur mon PC perso (a la maison), cela fonctionne parfaitement, mais ici il me fait n'importe quoi ...

Je pense que cela doit venir d'une différence de version, quelqu'un aurait une solution ?

Je ne peux pas poster mon fichier. Donnée confidentielle.

Merci d'avance pour votre aide.

[Transitoire]

Bonjour,

Sur mon PC perso (a la maison), cela fonctionne parfaitement, mais ici il me fait n'importe quoi ...

Il faudrais expliciter ce que vous entendez par "fait n'importe quoi", si vous souhaitez être aidé?

Cordialement

[poruss]

Salut,

En fait, il me place mes photos hors du cadre demandé et hors des dimensions demandés.

Je te joint des photos pour mieux illustrer.

Ici j'ai laisser la boucle se faire complétement :



Et ici, je stoppe ma boucle à la 1ere photo, pour montrer qu'elle n'est pas du tout en place.



Merci de ton soutient ;-)

[Transitoire]

Bonjour, en ce qui me concerne, je n'ai jamais fait d'importation de photos sur une feuille. Je ne suis pas celui qui pourra vous donner une réponse précise et efficace.
Toutefois, puisque cela marche sur votre ordinateur et pas sur d'autres, on peut légitimement penser qu'il y a un réglage différent.
Est-ce la dimensions de la photos qui est exprimée en cm dans l'un ou en pixel ou autre chose dans un autre? Ce qui imposerais une modification des dimensions en VBA?
Ceci est peut-être du a une modification de Microsoft dans une mise a jour ou une nouvelle version.
N'y-a-t-il pas une différence de Zoom qui s'appliquerais à la feuille et pas aux photos?
Je pense que la solution à votre problème est quelque part dans une petite modification.
N'ayant malheureusement pas les compétences dans ce domaine je vous rappellerai la morale d'une fable de La Fontaine "Patience et longueur de temps font mieux que force ni que rage"

Cordialement

[poruss]

Hello,

Tu m'a mis sur la bonne piste.

Tout simplement en regardant la propriété des différentes photos insérées, j'ai pu identifier que les photos décalés sur ma page sont celles qui ont étaient prises au format portrait...donc excel les insères à 90°.

Pour y remédier, j'ai mis une condition, si la rotation de l'image est différente de 0, alors on la passe à 0 ...

Voici le code sur mon fichier de travail.

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
 
    DOSSIER_PHOTO = "\\SERVEUR\04 - PHOTO\" & DOSSIER & "\"
    PHOTO = Dir(DOSSIER_PHOTO)
    POS_INIT = 2
    DIM_IMG = 24
 
 
    Do While PHOTO <> ""
    i = i + 1
    ActiveSheet.Range("L" & i) = PHOTO
    ActiveSheet.Range("A" & POS_INIT).Select
    ActiveSheet.Pictures.Insert(DOSSIER_PHOTO & PHOTO).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    If Selection.ShapeRange.Rotation <> 0 Then
    Selection.ShapeRange.Rotation = 0
    End If
    Selection.ShapeRange.Top = Range("A" & POS_INIT).Top
    Selection.ShapeRange.Left = Range("A" & POS_INIT).Left
    Selection.ShapeRange.Height = Range("A" & POS_INIT & ":G" & DIM_IMG).Height
    Selection.ShapeRange.Width = Range("A" & POS_INIT & ":G" & DIM_IMG).Width
 
    POS_INIT = POS_INIT + 25
    DIM_IMG = DIM_IMG + 25
    PHOTO = Dir
 
    Loop

Je te remercie pour ton aide.

Je passe le sujet en résolu.

Bonne continuation.