insertion de dessins

[capi]

Bonjour étant novice j'importe un dessin sous une cellule contenant un nom
le dessin ne doit pas dépasser les contours de la cellule et rester centré verticalement -sans que sa taille initiale ne change- même lorsque par besoin j'agrandi la largeur de ma colonne (car le nom au dessus du dessin est plus long que prévu)
merci à toute personne qui pourra m'indiquer comment faire espérant avoir été clair dans ma demande

 

[Yaloo]

Re : insertion de dessins

Bonjour capi,

Quelle est la demande exacte ?
Tu veux avoir des lignes soient plus hautes et garder le dessin centré sur la hauteur de la ligne ?

Yaloo

 

[Dranreb]

Re : insertion de dessins

Bonjour.
Je vous propose cette macro, à mettre dans un classeur de macros personnelles et à affecter à un nouveau bouton personnalisé de la barre d'outils dessin.

Sub SelMilieuPlage()
Dim Sh As Object
On Error GoTo Erreur
For Each Sh In Selection.ShapeRange
ObjMilieuPlage Sh
Next Sh
Exit Sub
Erreur: Resume AutreEssai
AutreEssai: On Error GoTo 0: Set Sh = Selection: ObjMilieuPlage Sh
End Sub
Sub ObjMilieuPlage(Sh As Object)
Dim Xm As Double, Ym As Double
Dim xG1 As Double, xG2 As Double, Xd1 As Double, Xd2 As Double, xMMei As Double, xMEss As Double
Dim yH1 As Double, yH2 As Double, yB1 As Double, yB2 As Double, yMMei As Double, yMEss As Double
Xm = Sh.Left + Sh.Width / 2: Ym = Sh.Top + Sh.Height / 2
With Sh.TopLeftCell
xG1 = .Left: xG2 = xG1 + .Width
yH1 = .Top: yH2 = yH1 + .Height
End With
With Sh.BottomRightCell
Xd1 = .Left: Xd2 = Xd1 + .Width
yB1 = .Top: yB2 = yB1 + .Height
End With
xMMei = (xG1 + Xd1) / 2
xMEss = (xG1 + Xd2) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
xMEss = (xG2 + Xd1) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
xMEss = (xG2 + Xd2) / 2: If Abs(xMEss - Xm) < Abs(xMMei - Xm) Then xMMei = xMEss
yMMei = (yH1 + yB1) / 2
yMEss = (yH1 + yB2) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
yMEss = (yH2 + yB1) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
yMEss = (yH2 + yB2) / 2: If Abs(yMEss - Ym) < Abs(yMMei - Ym) Then yMMei = yMEss
Sh.Left = xMMei - Sh.Width / 2
Sh.Top = yMMei - Sh.Height / 2
End Sub

Elle recadre un ou plusieurs objet(s) dessiné(s) selectionné(s) au milieu du groupe de cellules qu'il(s) recouvre(nt)
À +

 

[DoubleZero]

Re : insertion de dessins

Bonjour, capi, Yaloo, le Forum,

Une discussion qui pourrait aider.

Bon courage 🙂.

Bonjour, Dranreb.

 

[Dranreb]

Re : insertion de dessins

Je rectifie.
Ma macro fait mieux que ça.
Il est vrai que je l'ai écrite il y a longtemps.
Elle interprete la définition de "cellules recouvertes par le dessin"
Oui parce que le dessin peut ne mordre qu'un tout petit peut seulement sur les cellule recouvertes partiellements.
Alors il analyse s'il y a lieu d'en tenir compte ou pas selon la position initiale du centre du dessin en la modifiant le moins possible.

Plaisanterie: Par pitié, ne me demandez pas un programme qui énonce la description hiéraldique de blason en analysant son dessin !
Si j'ai le malheur de relever le défi, j'en deviendrais fou, c'est sûr !

À +

 

[BOISGONTIER]

Re : insertion de dessins

Bonjour,

Centre les images déjà importées.

Sub centreImages()
    Cells.SpecialCells(xlCellTypeConstants, 23).EntireColumn.AutoFit
    For Each c In Cells.SpecialCells(xlCellTypeConstants, 23)
      For Each s In ActiveSheet.Shapes
        If s.TopLeftCell.Address = c.Offset(1, 0).Address _
            Or s.TopLeftCell.Address = c.Address Then
          s.Name = c
          s.Left = c.Offset(1, 0).Left + c.Offset(1, 0).Width / 2 - s.Width / 2
          s.Top = c.Offset(1, 0).Top + 5
          c.Offset(1, 0).EntireRow.RowHeight = s.Height + 10
        End If
      Next s
    Next
End Sub

Voir pj

http://boisgontierjacques.free.fr/fichiers/Images/CentrageImages.xls

Pour importation automatique, préciser où sont les images?, quel est leur nom?

JB

 

[capi]

Re : insertion de dessins

merci pour vos réponses cela m'a déjà bien aidé j'ai suivi le lien pour une discussion de double zéro et j'ai copié le code cela a l'air de fonctionner si j'ai mis tous mes dessins mais si je dois en rajouter et que je rappuie sur mon bouton certains dessins remontent sur la ligne précédente de plus la hauteur des lignes ou je met mes dessins est de 51 y a-t-il une méthode pour que mes dessins tienne dans la hauteur du 1er coup ils sont rangés dans des dossiers chaque département a son dossier chaque dessin porte le nom de sa commune