papapaul
XLDnaute Impliqué
Bonsoir Forum,J'essaye de créer des "Plaques de portes" avec Logo pour des bureaux.
J'ai pas mal avancer en copiant une image "logo" manuellement" en A1
mais ce n'est pas vraiment "ancrer".
Ca à l'air de coller si c'est toujours le même.
Mais…., en fonction du résultat de ma recherche,
Le logo devra être différent selon l'agence (1,2,3)
et aussi la fonction.
Disons que j'ai 5 fonctions différentes pour chacune
des 3 agences soit 15 logos.
Ils sont par exemple dans un répertoire :
C:\Logo\
Dans ce repertoire il y a donc les 15 fichiers .jpg
Agence1\Assistant.jpg
Agence3\Conseiller.jpg
Etc…
Pour l'instant, ma plaque s'affiche bien
quand je doubleclique sur un des résultats
de ma recherche.
C'est tordu mon idée mais comment faire pour
que le logo change automatiquement en fonction de
La ligne que je doubleclique.(agence d'origine"feuille" et fonction"colonne B")
J'ai trouvé plusieurs exemples dont celui-ci de Robert
Mais c'est trop difficile pour moi
Sub Macro1()
'cette maco adapte la taille photo à la taille de la cellule
'déclaration des variables
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
'définit la variable dest
If Range('A1').Value = '' Then
Set dest = Range('A1') 'A1 si A1 est vide
Else 'sinon
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
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
Citation:
Sub Macro2()
'cette maco adapte la taille de la cellule à la taille de la photo
'déclaration des variables
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
'définit la variable dest
If Range('A1').Value = '' Then
Set dest = Range('A1') 'A1 si A1 est vide
Else 'sinon
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 = Selection.Height 'hauteur de la cellule dest
L = Selection.Width 'largeur de la cellule dest
'placement 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.Top = PV 'Position Verticale de l'image
.ShapeRange.Left = PH 'Position Horizontale de l'image
End With
'mise à l'échelle de la cellule
dest.RowHeight = H
If dest.ColumnWidth < L Then dest.ColumnWidth = H * 0.2285
dest.Offset(0, 1).Select 'désélectionne l'image
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
Je peux évidement modifier 1 par 1 mais en le faisant automatiquement
Ce serait top.
Si c'est trop dur, vous embêter pas, y a pas urgence.
Merci à tous et vive XLD
