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

Come modificare automaticamente la dimensione della forma in base / dipendente dal valore di cella specificato in Excel?

Se desideri modificare automaticamente la dimensione della forma in base al valore di una cella specificata, questo articolo può aiutarti.

Modifica automaticamente la dimensione della forma in base al valore della cella specificato con il codice VBA


Modifica automaticamente la dimensione della forma in base al valore della cella specificato con il codice VBA

Il seguente codice VBA può aiutarti a modificare una certa dimensione della forma in base al valore della cella specificato nel foglio di lavoro corrente. Si prega di fare quanto segue.

1. Fare clic con il pulsante destro del mouse sulla scheda del foglio con la forma necessaria per modificare le dimensioni, quindi fare clic su Visualizza codice dal menu di scelta rapida.

2. Nel Microsoft Visual Basic, Applications Edition finestra, copia e incolla il seguente codice VBA nella finestra del codice.

Codice VBA: modifica automatica delle dimensioni della forma in base al valore della cella specificato in 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

Note:: Nel codice, "Oval 2"È il nome della forma di cui cambierai le dimensioni. E Riga = 2, Colonna = 1 significa che la dimensione della forma "Ovale 2" verrà modificata con il valore in A2. Si prega di cambiarli come necessario.

Per il ridimensionamento automatico di più forme in base a diversi valori di cella, applica il codice VBA sottostante.

Codice VBA: ridimensiona automaticamente più forme in base al valore di celle specificate diverse in 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

Note:

1) Nel codice, "Oval 1","Faccina sorridente 3" e "Cuore 3"Sono i nomi delle forme che cambierai automaticamente le loro dimensioni. E A1, A2 eA3 sono le celle su cui ridimensionerai automaticamente le forme in base ai valori.
2) Se desideri aggiungere altre forme, aggiungi delle linee "ElseIf xAddress = "A3" Allora" e "Call SizeCircle (" Heart 2 ", Val (Target.Value))"sopra il primo"End If"nel codice. Modifica l'indirizzo della cella e il nome della forma in base alle tue esigenze.

3. Stampa altro + Q contemporaneamente i tasti per chiudere il file Microsoft Visual Basic, Applications Edition finestra.

D'ora in poi, quando modifichi il valore nella cella A2, la dimensione della forma Ovale 2 verrà modificata automaticamente. Vedi screenshot:

Oppure modificare i valori nelle celle A1, A2 e A3 per ridimensionare automaticamente le forme corrispondenti "Ovale 1", "Faccina 3" e "Cuore 3". Vedi screenshot:

Note:: La dimensione della forma non cambierà più quando il valore della cella è maggiore di 10.


Elenca ed esporta tutte le forme nella cartella di lavoro Excel corrente:

L' Esporta grafica utilità di Kutools for Excel ti aiuta a elencare rapidamente tutte le forme nella cartella di lavoro corrente e puoi esportarle tutte in una determinata cartella contemporaneamente mentre viene visualizzato lo screenshot qui sotto. Scaricalo e provalo ora! (30-giorni di percorso gratuito)


Articoli correlati:


I migliori strumenti per la produttività in ufficio

Kutools per Excel risolve la maggior parte dei tuoi problemi e aumenta la tua produttività dell'80%

  • Riutilizzo: Inserisci rapidamente formule complesse, grafici e tutto ciò che hai usato prima; Crittografa celle con password; Crea mailing list e invia email ...
  • Bar Super Formula (modifica facilmente più righe di testo e formula); Layout di lettura (leggi e modifica facilmente un gran numero di celle); Incolla su intervallo filtrato...
  • Unisci celle / righe / colonne senza perdere dati; Contenuto delle celle divise; Combina righe / colonne duplicate... Impedisci celle duplicate; Confronta intervalli...
  • Seleziona Duplica o Unico Righe; Seleziona Righe vuote (tutte le celle sono vuote); Super Find e Fuzzy Find in molte cartelle di lavoro; Selezione casuale ...
  • Copia esatta Più celle senza modificare il riferimento della formula; Riferimenti di creazione automatica a più fogli; Inserisci punti elenco, Caselle di controllo e altro ...
  • Estrai testo, Aggiungi testo, Rimuovi per posizione, Rimuovi spazio; Creare e stampare totali parziali di paging; Converti contenuto e commenti tra celle...
  • Super filtro (salva e applica schemi di filtri ad altri fogli); Ordinamento avanzato per mese / settimana / giorno, frequenza e altro; Filtro speciale in grassetto, corsivo ...
  • Combina cartelle di lavoro e fogli di lavoro; Unisci tabelle in base a colonne chiave; Suddividi i dati in più fogli; Conversione in batch xls, xlsx e PDF...
  • Più di 300 potenti funzionalità. Supporta Office/Excel 2007-2021 e 365. Supporta tutte le lingue. Facile implementazione nella tua azienda o organizzazione. Funzionalità complete Prova gratuita di 30 giorni. Garanzia di rimborso di 60 giorni.
scheda kte 201905

Scheda Office porta l'interfaccia a schede a Office e semplifica notevolmente il lavoro

  • Abilita la modifica e la lettura a schede in Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Apri e crea più documenti in nuove schede della stessa finestra, piuttosto che in nuove finestre.
  • Aumenta la produttività del 50% e riduce ogni giorno centinaia di clic del mouse!
fondo officetab
Commenti (16)
Ancora nessuna valutazione. Puoi essere il primo a votare!
Questo commento è stato fatto dal moderatore sul sito
Come lo eseguiresti con più forme ciascuna a seconda di celle diverse?
Questo commento è stato fatto dal moderatore sul sito
Cara Giada,
L'articolo viene aggiornato con una nuova sezione di codice che può aiutarti a eseguire con più forme ciascuna a seconda delle diverse celle. Grazie per il tuo commento.

I migliori saluti,
Cristallo
Questo commento è stato fatto dal moderatore sul sito
Come chiamo la mia forma? Nel tuo esempio sopra, come assegni il nome Oval 2 al cerchio che hai disegnato?
Questo commento è stato fatto dal moderatore sul sito
Caro Ranjit,
Per nominare una forma, seleziona questa forma, inserisci il nome della forma nella casella Nome, quindi premi il tasto Invio. Vedi sotto l'immagine mostrata.
Questo commento è stato fatto dal moderatore sul sito
Ciao, come faccio a replicare lo stesso per più forme collegate a più celle nello stesso modulo?
Questo commento è stato fatto dal moderatore sul sito
Caro Abhinaya,
L'articolo viene aggiornato con una nuova sezione di codice che può aiutarti a eseguire con più forme ciascuna a seconda delle diverse celle. Grazie per il tuo commento.

I migliori saluti,
Cristallo
Questo commento è stato fatto dal moderatore sul sito
Ciao,
Ho provato a usare il tuo post per scrivere il mio codice VBA ma non sembra andare molto lontano. Principalmente perché non capisco davvero VBA e sto solo cercando di adattare il tuo. Mi chiedevo se potessi aiutare. Voglio cambiare la lunghezza di un rettangolo a seconda del valore in una cella. Vorrei che la larghezza se il rettangolo rimanesse lo stesso ma la lunghezza cambiasse. Vorrei che entrambi i vertici di sinistra rimanessero nello stesso posto e si allungassero a destra. È possibile?
Grazie
Questo commento è stato fatto dal moderatore sul sito
Caro Lan,
Spero che il seguente codice VBA possa risolvere il tuo problema. (Sostituisci l'Oval 1 con il tuo nome di forma)

Private Sub Worksheet_Change (ByVal Target As Range)
On Error Resume Next
Se Target.Row = 2 e Target.Column = 1 Allora
Call SizeCircle("Ovale 1", Val(Target.Value))
End If
End Sub
Sub SizeCircle (nome come stringa, diametro)
Dim xCircle come forma
Dim xDiametro come singolo
In caso di errore Vai a ExitSub
xDiametro = Diametro
Se xDiameter > 10 Allora xDiameter = 10
Se xDiameter < 1 Allora xDiameter = 1
Imposta xCircle = ActiveSheet.Shapes(Nome)
xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
Con xCerchio
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(xDiametro)
Fine Con
ExitSub:
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, c'è un modo per far espandere la forma su due dimensioni (invece di aumentare la dimensione della forma di 5, aumentarla di 5 in orizzontale e 3 in verticale)?
Questo commento è stato fatto dal moderatore sul sito
Caro Sam,
Il seguente script VBA può aiutarti a risolvere il problema. E le due dimensioni sono la cella A1 e B1.

Private Sub Worksheet_Change (ByVal Target As Range)
On Error Resume Next
Se Target.Count = 1 Allora
If Not Intersect(Target, Range("A1:B1")) non è niente allora
Call SizeCircle("Ovale 2", Array(Val(Range("A1").Valore), Val(Range("B1").Valore)))
End If
End If
End Sub
Sub SizeCircle(Nome come stringa, Arr come variante)
Dim I quanto a lungo
Dim xCenterX come singolo
Dim xCenterY come singolo
Dim xCircle come forma
In caso di errore Vai a ExitSub
Per I = 0 A UBound(Arr)
Se Arr(I) > 10 Allora
Arr(I) = 10
ElseIf Arr(I) < 1 Allora
Arr(I) = 1
End If
Successiva
Imposta xCircle = ActiveSheet.Shapes(Nome)
Con xCerchio
xCenterX = .Sinistra + (.Larghezza / 2)
xCentroY = .Alto + (.Altezza / 2)
.Width = Applicazione.CentimetersToPoints(Arr(0))
.Altezza = Application.CentimetersToPoints(Arr(1))
.Sinistra = xCenterX - (.Larghezza / 2)
.Alto = xCentroY - (.Altezza / 2)
Fine Con
ExitSub:
End Sub
Questo commento è stato fatto dal moderatore sul sito
C'è un modo per farlo con le immagini? Non mi sembra di avere fortuna nell'usare il codice come pubblicato.

5 immagini in una classifica, voglio che le immagini al primo posto o al primo posto siano più grandi. Pertanto ho 1 dimensioni dell'immagine fisse, 1x2 per non il primo o 1x2 per il 2° posto (ad esempio). Ho già impostato il ranking, quindi posso usarlo per creare dimensioni in celle specifiche per ogni immagine (ad esempio, utilizzare un'istruzione IF, quindi IF RANK è la larghezza della prima dimensione è 4). Il mio VBA è piuttosto debole però.

Fondamentalmente voglio - sull'aggiornamento del foglio - guardare le celle delle dimensioni dell'immagine e impostare ogni dimensione dell'immagine sul risultato specifico delle celle delle dimensioni dell'immagine. Non riesco a vedere nel VBA sopra come funziona esattamente, ma penso che dovrebbe essere facile!
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristal,

Vorrei chiederti se esiste un modo per selezionare il colore (cella rossa = modulo rosso) e il nome da celle specifiche. potrebbe anche essere possibile creare moduli automaticamente da VBA?

Grazie mille in anticipo :)

carola
Questo commento è stato fatto dal moderatore sul sito
Ciao Cristal
e se per determinare il lato del cubo, triangolo, scatola che deve essere determinato in base alla lunghezza, larghezza? mi aiuti per favore

Grazie
sediail
Questo commento è stato fatto dal moderatore sul sito
Ciao Chairil,
Mi dispiace non poterti aiutare con quello ancora. Grazie per il tuo commento.
Questo commento è stato fatto dal moderatore sul sito
c'è un modo per farlo funzionare se la cella che stai usando per impostare la dimensione è il risultato di una formula piuttosto che solo un valore statico che inserisci manualmente?
Questo commento è stato fatto dal moderatore sul sito
Ciao mathnz, il codice VBA di seguito può aiutarti a risolvere il problema. Devi solo modificare le celle dei valori e i nomi delle forme nel codice in base ai tuoi dati.
Foglio di lavoro secondario privato_Calculate()
'Aggiornato da Extendoffice 20211105
On Error Resume Next
Call SizeCircle("Ovale 1", Val(Range("A1").Valore)) 'A1 è la cella del valore, Ovale 1 è il nome della forma
Call SizeCircle("Faccina sorridente 2", Val(Range("A2").Valore))
Call SizeCircle("Cuore 3", Val(Range("A3").Valore))

End Sub
Private Sub Worksheet_Change (ByVal Target As Range)
Dim xAddress come stringa
On Error Resume Next
Se Target.CountLarge = 1 Allora
xIndirizzo = Destinazione.Indirizzo(0, 0)
Se xAddress = "A1" Allora
Call SizeCircle("Ovale 1", Val(Target.Value))
ElseIf xAddress = "A2" Allora
Call SizeCircle("Faccina sorridente 2", Val(Target.Value))
ElseIf xAddress = "A3" Allora
Call SizeCircle("Cuore 3", Val(Target.Value))

End If
End If
End Sub

Sub SizeCircle (nome come stringa, diametro)
Dim xCenterX come singolo
Dim xCenterY come singolo
Dim xCircle come forma
Dim xDiametro come singolo
In caso di errore Vai a ExitSub
xDiametro = Diametro
Se xDiameter > 10 Allora xDiameter = 10
Se xDiameter < 1 Allora xDiameter = 1
Imposta xCircle = ActiveSheet.Shapes(Nome)
Con xCerchio
xCenterX = .Sinistra + (.Larghezza / 2)
xCentroY = .Alto + (.Altezza / 2)
.Width = Application.CentimetersToPoints(xDiametro)
.Altezza = Application.CentimetersToPoints(xDiameter)
.Sinistra = xCenterX - (.Larghezza / 2)
.Alto = xCentroY - (.Altezza / 2)
Fine Con
ExitSub:
End Sub

Non ci sono ancora commenti pubblicati qui
Lasciate i vostri commenti
Pubblicazione come ospite
×
Valuta questo post:
0   Personaggi
Posizioni suggerite

Seguici

Copyright © 2009 - www.extendoffice.com. | Tutti i diritti riservati. Offerto da ExtendOffice, | Mappa del sito
Microsoft e il logo Office sono marchi o marchi registrati di Microsoft Corporation negli Stati Uniti e / o in altri paesi.
Protetto da Sectigo SSL