[Yardım]  Makro ile grafik biçimlendirme

Excel Grafikleri ile ilgili işlemler

Makro ile grafik biçimlendirme

İleti#1)  hamidgf » 03 Ekm 2018 19:02

Merhaba,

Birden çok seri(çizgi) içeren grafikte, serileri tek tek biçimlendirmek yerine topluca seçip biçimlendirme yöntemi var mı?

Çizgi genişliğinin 2, düzleştirilmiş çizginin aktif, işaretçi boyutunun 4
Veri etiketlerinin aktif, sağda ve 8 punto

olacak şekilde makro ile bütün serilere uygulamamda yardımlarınızı rica ediyorum.

Böyle bir kod buldum bütün serilerin genişliğini ikiye çekiyor ancak vba bilmediğimden dolayı diğer özellikleri uyarlayamadım..
Kod: Tümünü seç
Sub Oval1_Tıklat()
Dim objSeries As Series
   With ActiveSheet.ChartObjects("Grafik 3").Chart
     For Each objSeries In .SeriesCollection
        With objSeries.Format.Line
                           .Transparency = 0
                           .Weight = 2
                         
        End With
     Next
  End With
End Sub
Kullanıcı avatarı
hamidgf
Yeni Başlamış
 
Kayıt: 01 Mar 2018 13:02
Meslek: Harita Mühendisi
Yaş: 27
İleti: 49
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kırşehir

Cevap: Makro ile grafik biçimlendirme

İleti#2)  hamidgf » 05 Ekm 2018 02:07

Etiketleri toplu değiştirmek için makro, (Çalışması için grafikte seri1 in etiketi açık olmalı, seri1 lejantta en üstte olan veri)
Kod: Tümünü seç
Sub Resim9_Tıklat()
'etiket ayarı

'Will change the font size for all data labels on the active chart

Dim x As Integer
Dim SizeNew As Variant
Dim myChart As Chart
Dim Name As String
Dim SizeOrig As Integer
Dim Response As Variant
Dim ser As Series

'define chart
    Set myChart = ActiveSheet.ChartObjects("Grafik 13").Chart


   
'define chart name
    Name = myChart.Name
    SizeOrig = myChart.SeriesCollection(1).DataLabels.Font.Size
       
'request font size
    SizeNew = InputBox("Grafik etiket boyu değiştirilecek. " _
        & vbNewLine & "Uygulanacak etiket boyunu giriniz.", "Etiket boyu")
   
'confirm if user clicked cancel or didn't enter anything and clicked ok
    If SizeNew = "" Then
        MsgBox ("Değişiklik uygulanmadı...")
        Exit Sub
    End If

'confirm that user entered a number
    If Not IsNumeric(SizeNew) Then
        MsgBox ("Lütfen sayısal değer giriniz.")
        Exit Sub
    End If

'confirm that font size is in range
    If SizeNew < 6 Or SizeNew > 18 Then
        Response = MsgBox("Uygulanacak etiket boyu " & SizeNew _
            & ", emin misiniz?  Devam etmek için Tamam, değişiklik yapmadan ayrılmak için İptale tıklayın. " _
            , vbOKCancel, "Etiket boyu standart dışı")
        If Response = vbCancel Then
            MsgBox ("Değişiklik uygulanmadı...")
            Exit Sub
        End If
    End If

'change data label size for each series that has data labels
    For x = 1 To myChart.SeriesCollection.Count
        If myChart.SeriesCollection(x).HasDataLabels Then
            myChart.SeriesCollection(x).DataLabels.Font.Size = SizeNew
        End If
    Next x
   
'redraw chart on screen (not sure why this isn't automatic, but it isn't)
    ActiveSheet.Calculate
    ActiveSheet.Range("CA1").ClearContents 'no idea why this works, but it does
    myChart.Refresh
   
'give option to revert to original size if one exists
    If Not IsNumeric(SizeOrig) Then Exit Sub 'confirm that we stored a starting font size
   
    Response = MsgBox("Etiket boyu " & _
        SizeNew & " olarak uygulanacak onaylamak için Tamam,  " & _
        "Orijinal boyut " & SizeOrig & _
        " değerine dönmek için iptale tıklayın.", vbOKCancel, "Değişikliği onayla")
       
    If Response = vbCancel Then
        For x = 1 To myChart.SeriesCollection.Count
            If myChart.SeriesCollection(x).HasDataLabels Then
                myChart.SeriesCollection(x).DataLabels.Font.Size = SizeOrig
            End If
        Next x
       
        ActiveSheet.Calculate
        ActiveSheet.Range("CA1").ClearContents 'no idea why this works, but it does
        myChart.Refresh
       
        MsgBox ("Etiket boyu orijinal değerine döndürüldü: " & _
            SizeOrig)
           
    End If
End Sub


Çizgi boyutunu toplu değiştirmek için makro
Kod: Tümünü seç
Sub Grafik3_Tıklat()
'Grafik1 çizgi ayarı
Dim x As Integer
Dim SizeNew As Variant
Dim myChart As Chart
Dim Name As String
Dim SizeOrig As Integer
Dim Response As Variant
Dim ser As Series

'define chart
    Set myChart = ActiveSheet.ChartObjects("Grafik 13").Chart

'confirm that a chart has been selected
    If myChart Is Nothing Then
        Response = MsgBox("You must select a chart before using this macro.", vbOKOnly, "No Chart Selected")
        Exit Sub
    End If
   
'define chart name
    Name = myChart.Name
    SizeOrig = myChart.SeriesCollection(1).Format.Line.Weight
       
'request font size
    SizeNew = InputBox("Grafik çizgi boyu değiştirilecek. " _
        & vbNewLine & "Uygulanacak çizgi boyunu giriniz.", "Çizgi boyu")
   
'confirm if user clicked cancel or didn't enter anything and clicked ok
    If SizeNew = "" Then
        MsgBox ("Değişiklik uygulanmadı....")
        Exit Sub
    End If

'confirm that user entered a number
    If Not IsNumeric(SizeNew) Then
        MsgBox ("Lütfen sayısal değer giriniz.")
        Exit Sub
    End If

'confirm that font size is in range
    If SizeNew < 1 Or SizeNew > 4 Then
        Response = MsgBox("Uygulanacak çizgi boyu " & SizeNew _
            & ", emin misiniz?  Devam etmek için Tamam, değişiklik yapmadan ayrılmak için İptale tıklayın. " _
            , vbOKCancel, "Çizgi boyu standart dışı")
        If Response = vbCancel Then
            MsgBox ("Değişiklik uygulanmadı...")
            Exit Sub
        End If
    End If

'change data label size for each series that has data labels
    For x = 1 To myChart.SeriesCollection.Count

            myChart.SeriesCollection(x).Format.Line.Weight = SizeNew

    Next x
   
'redraw chart on screen (not sure why this isn't automatic, but it isn't)
    ActiveSheet.Calculate
    ActiveSheet.Range("CA1").ClearContents 'no idea why this works, but it does
    myChart.Refresh
   
'give option to revert to original size if one exists
    If Not IsNumeric(SizeOrig) Then Exit Sub 'confirm that we stored a starting font size
   
    Response = MsgBox("Çizgi boyu " & _
        SizeNew & " olarak uygulanacak onaylamak için Tamam,  " & _
        "Orijinal boyut " & SizeOrig & _
        " değerine dönmek için iptale tıklayın.", vbOKCancel, "Değişikliği onayla")
       
    If Response = vbCancel Then
        For x = 1 To myChart.SeriesCollection.Count
         
                myChart.SeriesCollection(x).Format.Line.Weight = SizeOrig

        Next x
       
        ActiveSheet.Calculate
        ActiveSheet.Range("CA1").ClearContents 'no idea why this works, but it does
        myChart.Refresh
       
        MsgBox ("Çizgi boyu orijinal değerine döndürüldü: " & _
            SizeOrig)
           
    End If
End Sub


Kaynak aktif grafik olarak düzenlemiş makroyu, grafiği normal seçip makroyu aktif edince "aktif grafik" yok uyarısı veriyor. Grafiği "Giriş/bul seç/nesne seç" ile seçmek gerekiyor.

İyi forumlar.

kaynak: https://www.mrexcel.com/forum/excel-que ... ost4901046
Kullanıcı avatarı
hamidgf
Yeni Başlamış
 
Kayıt: 01 Mar 2018 13:02
Meslek: Harita Mühendisi
Yaş: 27
İleti: 49
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kırşehir


Forum Excel Grafik İşlemleri

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

cron
Bumerang - Yazarkafe