WDAndCo
XLDnaute Impliqué
Bonjour le Forum
J'ai ce bout de code qui en fonction de différents criteres choisi la bonne image (de taille et sens différent pour l'instant)
Mais en fonction de l'écran sa tombe a coté du cadre (D2 à I9) comment eviter cela.
D'avance merci
J'ai ce bout de code qui en fonction de différents criteres choisi la bonne image (de taille et sens différent pour l'instant)
Code:
If Dessin = "MD2P" Then Gauche = 50: Haut = -140: Reduc = 1: Rota = 90
If Dessin = "MG2P" Then Gauche = -20: Haut = -140: Reduc = 1: Rota = 90
If Dessin = "MG0PVCC" Then Gauche = -20: Haut = -155: Reduc = 1: Rota = 90
If Dessin = "MD0PVCC" Then Gauche = 40: Haut = -155: Reduc = 1: Rota = 90
If Dessin = "MG8PVCC" Then Gauche = -40: Haut = -150: Reduc = 1: Rota = 90
If Dessin = "MD8PVCC" Then Gauche = -40: Haut = -150: Reduc = 1: Rota = 90
If Dessin = "MDTJD" Then Gauche = -70: Haut = -90: Reduc = 0.6: Rota = 90
If Dessin = "MGTJD" Then Gauche = 0: Haut = -90: Reduc = 0.6: Rota = 90
If Dessin = "MDVCC2PTJD" Then Gauche = -70: Haut = -80: Reduc = 0.6: Rota = 90
If Dessin = "MGVCC2PTJD" Then Gauche = 0: Haut = -80: Reduc = 0.6: Rota = 90
If Dessin = "HJL" Then Gauche = 150: Haut = 150: Reduc = 1.5: Rota = 0
Sheets("Schemas Aiguille").Visible = True 'Feuille qui contient les dessins
Sheets("Schemas Aiguille").Select
Range("E1") = Dessin 'Nom du dessin choisi
ActiveSheet.Shapes(Dessin).Copy
Sheets("Schemas Aiguille").Visible = False
Sheets("Fiche Projet").Select 'Feuille ou seras copier le dessin
DeProtege
Range("F5").Select
ActiveSheet.Paste 'Mise en forme
Selection.ShapeRange.IncrementRotation Rota
Selection.ShapeRange.IncrementLeft Gauche
Selection.ShapeRange.IncrementTop Haut
Selection.ShapeRange.ScaleHeight Reduc, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleWidth Reduc, msoFalse, msoScaleFromTopLeft
If Dessin <> "HJL" Then Selection.ShapeRange.Name = "Dessin": Range("H9").Value = 1'test si dessin ou pas
If Dessin = "HJL" Then MsgBox ("Pas de Dessin pour cette installation : Voir Jean Louis"): ActiveSheet.Shapes("HJL").Delete: Range("H9").Value = 0
Protege
Range("C2").Select
D'avance merci