Une image qui tombe hors du cadre selon l'écran

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)
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
Mais en fonction de l'écran sa tombe a coté du cadre (D2 à I9) comment eviter cela.
D'avance merci
 

WDAndCo

XLDnaute Impliqué
Re : Une image qui tombe hors du cadre selon l'écran

Bonjour le Forum et Paritec

Comment coller une image pas toujours la même qui n'ont pas les mêmes dimensions qui sont dans un autre onglet et cela sur cadre qui comporte les cellules de D2 a I9

D'avance merci
 

Modeste geedee

XLDnaute Barbatruc
Re : Une image qui tombe hors du cadre selon l'écran

Bonsour®
utiliser les objets Image ActiveX
adapter la propriété PictureSizeMode selon besoin
Capture.JPG

0 -Clip : l'image est insérée, non redimensionnée, , tronquée selon le cas
1 - Stretch : l'image est insérée, et déformée pour s'adapter intégralement au conteneur
2 - Zoom : l'image est insérée et redimensionnée proportionnellement pour être visible entiérement
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    80.3 KB · Affichages: 43
  • Capture.JPG
    Capture.JPG
    80.3 KB · Affichages: 41

WDAndCo

XLDnaute Impliqué
Re : Une image qui tombe hors du cadre selon l'écran

Bonjour le Forum et Modeste geedee

Comment adapter cela à ce code ? (Je suis en XP)
Code:
 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("D2:I9").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
D'avance merci
 

WDAndCo

XLDnaute Impliqué
Re : Une image qui tombe hors du cadre selon l'écran

Bonjour le Forum

J'ai trouvé cela :
Code:
ActiveSheet.Paste
        Selection.ShapeRange.IncrementRotation Rota
        Selection.ShapeRange.IncrementLeft = Range("D2").Left
        Selection.ShapeRange.IncrementTop = Range("D2").Top
        Selection.ShapeRange.ScaleHeight = Range("D2:I9").Height
        Selection.ShapeRange.ScaleWidth = Range("D2:I9").Width
Mais bien sur ça ne fonctionne pas. Donc comment mettre le dessin qui a était choisi sur les cellules de D2 à I9

D'avance merci
 

WDAndCo

XLDnaute Impliqué
Re : Une image qui tombe hors du cadre selon l'écran

Bonjour le Forum

J'ai trouvé. Cela est provoqué par la version d'Excel !
Donc je vais codé en double. La position des dessins.

Comment connaitre la version d'Excel pour faire une selection ?

D'avance merci.
 

MJ13

XLDnaute Barbatruc
Re : Une image qui tombe hors du cadre selon l'écran

Bonjour à tous

Un des moyens pour connaître la version d'Excel est de taper dans une cellule:

Code:
=INFORMATIONS("version")

Ensuite suivant le résultat tu auras pour PC: 7=95, 8=97, 9=2000, 10=2002, 11=2003, 12=2007, 14=2010 et 15=2013

Mais il doit y avoir un moyen par VBA.
 

Discussions similaires