Note: The other languages of the website are Google-translated. Back to English
English English

Comment changer automatiquement la taille de la forme en fonction / en fonction de la valeur de cellule spécifiée dans Excel?

Si vous souhaitez modifier automatiquement la taille de la forme en fonction de la valeur d'une cellule spécifiée, cet article peut vous aider.

Modification automatique de la taille de la forme en fonction de la valeur de cellule spécifiée avec le code VBA


Modification automatique de la taille de la forme en fonction de la valeur de cellule spécifiée avec le code VBA


Le code VBA suivant peut vous aider à modifier une certaine taille de forme en fonction de la valeur de cellule spécifiée dans la feuille de calcul actuelle. Veuillez faire comme suit.

1. Cliquez avec le bouton droit sur l'onglet de la feuille avec la forme dont vous avez besoin pour modifier la taille, puis cliquez sur Voir le code dans le menu contextuel.

2. dans le Microsoft Visual Basic pour applications fenêtre, copiez et collez le code VBA suivant dans la fenêtre Code.

Code VBA: modification automatique de la taille de la forme en fonction de la valeur de cellule spécifiée dans Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Notes: Dans le code, "2 ovale»Est le nom de la forme dont vous allez modifier sa taille. Et Ligne = 2, Colonne = 1 signifie que la taille de la forme «Ovale 2» sera modifiée avec la valeur en A2. Veuillez les changer selon vos besoins.

Pour redimensionner automatiquement plusieurs formes en fonction de différentes valeurs de cellule, veuillez appliquer le code VBA ci-dessous.

Code VBA: redimensionner automatiquement plusieurs formes en fonction de la valeur de différentes cellules spécifiées dans Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Notes:

1) Dans le code, "1 ovale","Visage souriant 3" et "Coeur 3”Sont le nom des formes, vous modifierez leurs tailles automatiquement. Et A1, A2 et des toursA3 sont les cellules sur lesquelles vous redimensionnerez automatiquement les formes.
2) Si vous souhaitez ajouter plus de formes, veuillez ajouter des lignes "ElseIf xAddress = "A3" Alors"Et "Call SizeCircle (" Heart 2 ", Val (Target.Value))"au-dessus du premier"Si fin"dans le code. Et modifiez l'adresse de la cellule et le nom de la forme en fonction de vos besoins.

3. presse autre + Q touches simultanément pour fermer le Microsoft Visual Basic pour applications fenêtre.

Désormais, lorsque vous modifiez la valeur dans la cellule A2, la taille de la forme Ovale 2 sera modifiée automatiquement. Voir la capture d'écran:

Ou modifiez les valeurs dans les cellules A1, A2 et A3 pour redimensionner automatiquement les formes correspondantes "Ovale 1", "Smiley Face 3" et "Coeur 3". Voir la capture d'écran:

Notes: La taille de la forme ne changera plus lorsque la valeur de la cellule est supérieure à 10.


Répertoriez et exportez toutes les formes du classeur Excel actuel:

La série Exporter des graphiques utilité de Kutools pour Excel vous aider à répertorier rapidement toutes les formes du classeur actuel, et vous pouvez toutes les exporter dans un certain dossier à la fois comme le montre la capture d'écran ci-dessous. Téléchargez et essayez-le maintenant! (Parcours gratuit de 30 jours)


Articles Liés:


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (16)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
Comment exécuteriez-vous cela avec plusieurs formes, chacune dépendant de différentes cellules ?
Ce commentaire a été minimisé par le modérateur sur le site
Chère Jade,
L'article est mis à jour avec une nouvelle section de code qui peut vous aider à exécuter avec plusieurs formes, chacune dépendant de différentes cellules. Merci pour votre commentaire.

Meilleures salutations,
Cristal
Ce commentaire a été minimisé par le modérateur sur le site
Comment nommer ma forme ? Dans votre exemple ci-dessus, comment attribuez-vous le nom Ovale 2 au cercle que vous avez dessiné ?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Ranjit,
Pour nommer une forme, veuillez sélectionner cette forme, entrez le nom de la forme dans la zone Nom, puis appuyez sur la touche Entrée. Voir ci-dessous l'image montrée.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, comment puis-je reproduire la même chose pour plusieurs formes liées à plusieurs cellules dans le même module ?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Abhinaya,
L'article est mis à jour avec une nouvelle section de code qui peut vous aider à exécuter avec plusieurs formes, chacune dépendant de différentes cellules. Merci pour votre commentaire.

Meilleures salutations,
Cristal
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
J'ai essayé d'utiliser votre message pour écrire mon propre code VBA, mais je ne semble pas aller très loin. Principalement parce que je ne comprends pas vraiment VBA et que j'essaie juste d'adapter votre. Je me demandais si vous pouviez aider. Je souhaite modifier la longueur d'un rectangle en fonction de la valeur d'une cellule. Je voudrais que la largeur du rectangle reste la même mais que la longueur change. Je voudrais que les deux sommets de gauche restent au même endroit et qu'ils s'allongent vers la droite. Est-ce possible?
Merci
Ce commentaire a été minimisé par le modérateur sur le site
Cher lan,
J'espère que le code VBA suivant pourra résoudre votre problème. (Veuillez remplacer l'ovale 1 par votre propre nom de forme)

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
On Error Resume Next
Si Target.Row = 2 et Target.Column = 1 alors
Call SizeCircle("Ovale 1", Val(Target.Value))
Si fin
End Sub
Sous-tailleCircle (nom sous forme de chaîne, diamètre)
Dim xCercle comme forme
Dim xDiameter comme simple
En cas d'erreur GoTo ExitSub
xDiamètre = Diamètre
Si xDiamètre > 10 Alors xDiamètre = 10
Si xDiamètre < 1 Alors xDiamètre = 1
Set xCircle = ActiveSheet.Shapes(Nom)
xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
Avec xCercle
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(xDiameter)
Terminer par
ExitSub :
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, existe-t-il un moyen de faire en sorte que la forme se développe sur deux dimensions (au lieu d'augmenter la taille de la forme de 5, augmentez-la de 5 à l'horizontale et de 3 à la verticale) ?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Sam,
Le script VBA suivant peut vous aider à résoudre le problème. Et les deux dimensions sont les cellules A1 et B1.

Private Sub Worksheet_Change (Cible ByVal en tant que plage)
On Error Resume Next
Si Target.Count = 1 Alors
Si ce n'est pas l'intersection (cible, plage ("A1: B1")) n'est rien alors
Call SizeCircle("Ovale 2", Array(Val(Plage("A1").Valeur), Val(Plage("B1").Valeur)))
Si fin
Si fin
End Sub
Sub SizeCircle (Nom en tant que chaîne, Arr en tant que variante)
Dim I As Long
Dim xCenterX comme simple
Dim xCenterY comme simple
Dim xCercle comme forme
En cas d'erreur GoTo ExitSub
Pour I = 0 Vers UBound(Arr)
Si Arr(I) > 10 Alors
Arr(I) = 10
SinonSi Arr(I) < 1 Alors
Arr(I) = 1
Si fin
Suivant
Set xCircle = ActiveSheet.Shapes(Nom)
Avec xCercle
xCentreX = .Gauche + (.Largeur / 2)
xCentreY = .Haut + (.Hauteur / 2)
.Largeur = Application.CentimetersToPoints(Arr(0))
.Height = Application.CentimetersToPoints(Arr(1))
.Gauche = xCentreX - (.Largeur / 2)
.Haut = xCentreY - (.Hauteur / 2)
Terminer par
ExitSub :
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Existe-t-il un moyen de le faire avec Images ? Je ne semble pas avoir de chance d'utiliser le code tel qu'il est affiché.

5 images dans un classement, je veux que les images en 1ère ou à égalité pour la 1ère soient plus grandes. J'ai donc 2 tailles d'image fixes, soit 1x2 pour pas premier ou 2x4 pour 1er placé (par exemple). J'ai déjà configuré le classement, je peux donc l'utiliser pour créer des tailles dans des cellules spécifiques pour chaque image (c'est-à-dire utiliser une instruction IF donc IF RANK est la 1ère largeur de taille est 2). Mon VBA est assez faible cependant.

Fondamentalement, je veux - lors de la mise à jour de la feuille - regarder les cellules de taille d'image et définir chaque taille d'image sur le résultat spécifique des cellules de taille d'image. Je ne vois pas dans le VBA ci-dessus comment cela fonctionne exactement, mais je pense que cela devrait être facile!
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

Je voudrais vous demander s'il existe un moyen de sélectionner la couleur (cellule rouge = forme rouge) et le nom de cellules spécifiques. serait-il également possible de créer automatiquement des formulaires à partir de VBA ?

Merci d'avance :)

Carol
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal
et si pour déterminer le côté du cube, du triangle, de la boîte qui doit être déterminé en fonction de la longueur, de la largeur? Aidez-moi, s'il vous plaît

Merci
chaire
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Chairil,
Désolé, je ne peux pas encore vous aider. Merci pour votre commentaire.
Ce commentaire a été minimisé par le modérateur sur le site
existe-t-il un moyen pour que cela fonctionne si la cellule que vous utilisez pour définir la taille est le résultat d'une formule plutôt qu'une simple valeur statique que vous entrez manuellement ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut mathnz, Le code VBA ci-dessous peut vous aider à résoudre le problème. Il vous suffit de modifier les cellules de valeur et les noms de forme dans le code en fonction de vos propres données.
Sous-feuille de calcul privée_Calculate ()
'Mis à jour par Extendoffice 20211105
On Error Resume Next
Call SizeCircle("Ovale 1", Val(Plage("A1").Valeur)) 'A1 est la cellule de valeur, Ovale 1 est le nom de la forme
Call SizeCircle("Smiley Face 2", Val(Range("A2").Valeur))
Call SizeCircle("Heart 3", Val(Range("A3").Value))

End Sub
Private Sub Worksheet_Change (Cible ByVal en tant que plage)
Dim xAddress As String
On Error Resume Next
Si Target.CountLarge = 1 Alors
xAddress = Target.Address(0, 0)
Si xAdresse = "A1" Alors
Call SizeCircle("Ovale 1", Val(Target.Value))
ElseIf xAddress = "A2" Alors
Call SizeCircle("Smiley Face 2", Val(Target.Value))
ElseIf xAddress = "A3" Alors
Call SizeCircle("Heart 3", Val(Target.Value))

Si fin
Si fin
End Sub

Sous-tailleCircle (nom sous forme de chaîne, diamètre)
Dim xCenterX comme simple
Dim xCenterY comme simple
Dim xCercle comme forme
Dim xDiameter comme simple
En cas d'erreur GoTo ExitSub
xDiamètre = Diamètre
Si xDiamètre > 10 Alors xDiamètre = 10
Si xDiamètre < 1 Alors xDiamètre = 1
Set xCircle = ActiveSheet.Shapes(Nom)
Avec xCercle
xCentreX = .Gauche + (.Largeur / 2)
xCentreY = .Haut + (.Hauteur / 2)
.Width = Application.CentimetersToPoints(xDiameter)
.Height = Application.CentimetersToPoints(xDiameter)
.Gauche = xCentreX - (.Largeur / 2)
.Haut = xCentreY - (.Hauteur / 2)
Terminer par
ExitSub :
End Sub

Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés