Excel'de belirtilen hücre değerine dayalı / bağlı olarak şekil boyutunu otomatik olarak nasıl değiştirebilirim?
Şekil boyutunu belirli bir hücrenin değerine göre otomatik olarak değiştirmek istiyorsanız, bu makale size yardımcı olabilir.
VBA kodu ile belirtilen hücre değerine göre şekil boyutunu otomatik değiştir
VBA kodu ile belirtilen hücre değerine göre şekil boyutunu otomatik değiştir
Aşağıdaki VBA kodu, geçerli çalışma sayfasındaki belirtilen hücre değerine göre belirli bir şekil boyutunu değiştirmenize yardımcı olabilir. Lütfen aşağıdaki işlemleri yapın.
1. Boyutunu değiştirmeniz gereken şekli içeren sayfa sekmesine sağ tıklayın ve ardından Kodu Görüntüle sağ tıklama menüsünden.
2. içinde Uygulamalar için Microsoft Visual Basic penceresinde, aşağıdaki VBA kodunu Kod penceresine kopyalayıp yapıştırın.
VBA kodu: Excel'de belirtilen hücre değerine göre otomatik şekil boyutunu değiştir
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
not: Kodda, "Oval 2"Boyutunu değiştireceğiniz şeklin adıdır. Ve Satır = 2, Sütun = 1 "Oval 2" şeklinin boyutunun A2'deki değerle değiştirileceği anlamına gelir. Lütfen ihtiyaç duyduğunuzda değiştirin.
Farklı hücre değerlerine göre birden çok şekli otomatik olarak yeniden boyutlandırmak için lütfen aşağıdaki VBA kodunu uygulayın.
VBA kodu: Excel'de belirtilen farklı hücrelerin değerine göre birden çok şekli otomatik olarak yeniden boyutlandırın
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
Notlar:
3. Basın Ara Toplam + Q kapatmak için aynı anda tuşları Uygulamalar için Microsoft Visual Basic pencere.
Şu andan itibaren, A2 hücresindeki değeri değiştirdiğinizde, Oval 2 şeklinin boyutu otomatik olarak değişecektir. Ekran görüntüsüne bakın:
Veya karşılık gelen "Oval 1", "Gülen Yüz 2" ve "Kalp 3" şekillerini otomatik olarak yeniden boyutlandırmak için A1, A3 ve A3 hücresindeki değerleri değiştirin. Ekran görüntüsüne bakın:
not: Hücre değeri 10'dan büyük olduğunda şekil boyutu artık değişmeyecektir.
Geçerli Excel çalışma kitabındaki tüm şekilleri listeleyin ve dışa aktarın:
The Grafikleri Dışa Aktar yarar Kutools for Excel mevcut çalışma kitabındaki tüm şekilleri hızlı bir şekilde listelemenize yardımcı olur ve hepsini aşağıdaki ekran görüntüsü shwon gibi tek seferde belirli bir klasöre aktarabilirsiniz. Şimdi indirin ve deneyin! (30 günlük ücretsiz iz)
İlgili yazılar:
- Excel'de belirli bir şekle fare ucu nasıl eklenir?
- Excel'de şeffaf arka plan rengiyle bir şekil nasıl doldurulur?
- Excel'de belirtilen hücre değerine göre belirli bir şekli nasıl gizleyebilir veya gösterebilirim?
En İyi Ofis Üretkenlik Araçları
Kutools for Excel ile Excel Becerilerinizi Güçlendirin ve Daha Önce Hiç Olmadığı Gibi Verimliliği Deneyimleyin. Kutools for Excel, Üretkenliği Artırmak ve Zamandan Tasarruf Etmek için 300'den Fazla Gelişmiş Özellik Sunar. En Çok İhtiyacınız Olan Özelliği Almak İçin Buraya Tıklayın...
Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir
- Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
- Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
- Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!