je reviens à la charge !

Re : je reviens à la charge !

Bonjour zesuila, bonjour à tous,

A tout hasard, as-tu essayé avec le mot clé "CurDir" qui te renvoie le chemin d'accès défini avec Chdrive et/ou chdir?

@+

Gael

Re : je reviens à la charge !

bonjour Gael

Non je ne connais pas curdir, ou dois je le mettre ?

Re : je reviens à la charge !

Re Zesuila,

Tu peux le mettre dans une variable:

Dim Chemin as string

ChDrive "C"
ChDir "C:\GD"

chemin = CurDir
...

La variable Chemin contient "C:\GD"

L'instruction Chdir ne modifie pas le drive en cours, donc si tu fais:

ChDrive "Z"
ChDir "C:\GD"

Curdir va renvoyer le chemin par défaut de "Z:" et non C:\GD.

Par contre:

ChDrive "Z"
ChDir "\GD"

Curdir renvoie Z:\GD

et si tu ajoutes:

ChDir "Test"

Curdir renverra "C:\GD\Test"


@+

Gael

PS: un bout de code récupéré sur Internet et qui marche bien en tenant compte du répertoire défini avec Chdrive et Chdir. Je n'ai pas réussii à faire fonctionner correctement le "xlDialogInsertPicture" qui revient toujours au répertoire par défaut de "Mes images" et je n'arrive pas non plus à utiliser les arguments "File_name" et "Filter_index".

Sub SelectandInsert()
Dim vaFile As Variant

vaFile = Application.GetOpenFilename _
(filefilter:=("BMP files,*.BMP"), Title:="Select picture", MultiSelect:=False)
If vaFile = False Then Exit Sub

ActiveSheet.Pictures.Insert (vaFile)

End Sub

Re : je reviens à la charge !

YESSSSSSS !!!
Merci Gael !
C'est ce petit bout de code glané sur internet qui fonctionne (en tout cas pour mon cas !)
j'ai simplement changé les bmp en jpg!

Sub SelectandInsert()
Dim vaFile As Variant
ChDrive "Q"
ChDir "\PHOTOS"
Chemin = CurDir

vaFile = Application.GetOpenFilename _
(filefilter:=("jpg files,*.JPG"), Title:="Select picture", MultiSelect:=False)
If vaFile = False Then Exit Sub

ActiveSheet.Pictures.Insert (vaFile)

End Sub

Ah oui vraiment merci car cela faisait un paquet de temps que je cherchais la solution dans les divers forums. A tout hasard ou as tu trouvé cette info ?

Je te souhaite une très bonne année

Re : je reviens à la charge !

ouin !!
J'y est cru pourtant !
En fait c'est presque cela !
Mais dans mon programme la photo insérée se place au milieu d'une cellule fusionnée (avec donc Application.Dialogs(xlDialogInsertPicture).Show)

voici le code en entier
Dim Chemin As String
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object
Dim dest As Range 'destination
Dim PV As Double 'Position Verticale
Dim PH As Double 'Position Horizontale
Dim L As Double 'Largeur
Dim H As Double 'Hauteur
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next
Range("A10").Activate
ChDrive "Q"
ChDir "\PHOTOS"
Chemin = CurDir
Application.Dialogs(xlDialogInsertPicture).Show
'définit la variable dest

If Range("A10").Value = "" Then
Set dest = Range("A10:B10") 'A1 si A1 est vide
Else 'sinon
Set dest = Range("A10:B10")
'Set dest = Range("A65536").End(xlUp).Offset(1, 0) 'La première ligne vide de la colonne A
End If
dest.Value = " " 'met un espace la la cellule Dest
'définition des variables
PV = dest.Top 'haut de la cellule dest
PH = dest.Left 'gauche de la cellule dest
H = dest.Height 'hauteur de la cellule dest
L = dest.Width 'largeur de la cellule dest
'placement et mise à l'échelle de l'image
On Error GoTo Fin 'gestion de l'erreur via la balise 'fin' si aucune image n'est sélectionnée
With Selection
.ShapeRange.LockAspectRatio = msoTrue 'conserve le rapport Horizopntal/Vertical de l'image
.ShapeRange.Width = L 'largeur de l'image
If .ShapeRange.Height > H Then .ShapeRange.Height = H 'hauteur de l'image
.ShapeRange.Top = PV + (H - .ShapeRange.Height) / 2 'Position centrée Verticale de l'image
.ShapeRange.Left = PH + (L - .ShapeRange.Width) / 2 'Position centrée Horizontale de l'image
End With
dest.Offset(0, 1).Select 'désélectionne l'image
UserForm1.Hide
ActiveWindow.SelectedSheets.PrintPreview
UserForm1.Show
Frame3.SetFocus
TextBox6.SetFocus

Exit Sub 'sort de la procédure
Fin: 'balise
dest.Value = "" 'vide la cellule dest
'MsgBox "L'image doit ête sélectionnée.' 'message"
End Sub

Si je mets ton code, la photo vient se placer en A10 mais n'est pas "centrée" dans la cellule fusionnée A10:B10
Ya t'il une astuce ?

Re : je reviens à la charge !

Bonsoir Zesuila, bonsoir à tous,

Comme je n'ai pas pu trouver la solution, j'ai écrit à Ti qui est membre de ce forum et qui a également son propre site (http://www.veriti.net). Il m'a répondu très rapidement en m'envoyant le code suivant:

Sub Image()
Dim Chemin As String
Dim Emplacement As Range
Dim Image As Object
Dim Dest As Range 'destination
Dim PV As Double 'Position Verticale
Dim PH As Double 'Position Horizontale
Dim L As Double 'Largeur
Dim H As Double 'Hauteur
Dim Shp As Shape, F


F = Application.GetOpenFilename("images (*.bmp;*.jpg;*.gif),*.bmp;*.jpg;*.gif", 2, "Image")
If F = False Then Exit Sub

With ActiveSheet
For Each Shp In .Shapes
Shp.Delete
Next Shp

Set Shp = .Shapes(.Pictures.Insert(F).Name)

Set Dest = .Range("A10:B10")

Dest.Value = " " 'met un espace la la cellule Dest
With Dest
PV = .Top 'haut de la cellule dest
PH = .Left 'gauche de la cellule dest
H = .Height 'hauteur de la cellule dest
L = .Width 'largeur de la cellule dest
End With

On Error GoTo Fin
With Shp
.LockAspectRatio = msoTrue
.Width = L
If .Height > H Then .Height = H
.Top = PV + (H - .Height) / 2
.Left = PH + (L - .Width) / 2
End With

.PrintPreview
End With
Exit Sub
Fin:
Dest.Value = ""
'MsgBox "L'image doit ête sélectionnée.' 'message"
End Sub

J'ai essayé chez moi, ça a l'air de marcher. Il faut simplement rajouter les CHdrive et CHdir qui conviennent pour ouvrir le bon répertoire.

@+

Gaël