Makroda çözümü kolay olabilecek bir sorun yaşıyorum

[Narhome]

Merhabalar,

11597 Satırlık bir verilerim var. Her 11 satırdan 1 grafik üretiyorum. 6 sütun 11 satır kullanıyorum her grafik için. Sütunlar sabit ama satır numaraları Örneğin; 1. grafik "D2:I12", 2. grafik "D13:I23", 3. Grafik D24:I34 bu şekilde satır değerleri sabit 11 olarak artan 1000 i geçen sayıda bir grafik elde edeceğim. Bu grafikleride pdf olarak makroda yazdıracağım.

Tek satırdan grafiği üretebiliyor olsaydım For döngüsüyle işi çözerdim fakat birden çok satır kullandığım için (D2:I12, D13:I23 vs gibi) bunu beceremedim. Makroya yeni öğrenmeye başladığım için (1gün) çözemedim daha doğrusu. Yardımcı olabilirseniz sevinirim. Kodlarımı aşağıya bırakıyorum

Sub Makro1()
Dim chartName As String
Dim chartNumber As Integer
chartNumber = 1 ' Başlangıç için grafik numarasını 1

For i = 2 To 11597 Step 11 ' Pdf dosyasına isim ve Grafiğe başlık verirken kullanıyorum. B sütunun da Grafiğe ve dosyaya vereceğim isimler var
    
        Range("D2:I12").Select
        chartName = "Grafik" & chartNumber ' Her döngü için benzersiz grafik ismi
        ActiveSheet.Shapes.AddChart2(227, xlLine).Select
        ActiveChart.Parent.Name = chartName ' Grafik ismini ayarla
        
        With ActiveSheet.Shapes(chartName)
            .IncrementLeft 89.1176377953
            .IncrementTop -210.8823622047
            .ScaleWidth 2.7279413823, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 1.9971405658, msoFalse, msoScaleFromTopLeft
        End With
        
        With ActiveChart
            .SetElement (msoElementDataLabelTop)
            .SetElement (msoElementDataTableWithLegendKeys)
            .ChartTitle.Select
            Selection.Caption = "='ANADOSYA'!B" & i
            .ChartArea.Select
        End With
        
        ChDir "C:\Users\homenar\Desktop\deneme"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\homenar\Desktop\deneme\" & Sheets("ANADOSYA").Range("B" & i) & ".pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        ActiveChart.Parent.Delete
        chartNumber = chartNumber + 1 ' Grafik numarasını artır

Next i

End Sub

 

[muhasebeciyiz]

Sub Makro1()
    
    Dim chartName As String
    Dim chartNumber As Integer
    Dim satirBaslangic As Integer
    Dim satirBitis As Integer
    
    chartNumber = 1
    satirBaslangic = 2

    For i = 1 To 1054 ' 11597 satırı 11'e böldüğümüzde 1054 kalan elde ederiz.
      
        For j = 1 To 11
            satirBitis = satirBaslangic + j - 1

            
            Range("D" & satirBaslangic & ":I" & satirBitis).Select
            
            chartName = "Grafik" & chartNumber
            
            ActiveSheet.Shapes.AddChart2(227, xlLine).Select
            
            ActiveChart.Parent.Name = chartName
            
            With ActiveSheet.Shapes(chartName)
                .IncrementLeft 89.1176377953
                .IncrementTop -210.8823622047
                .ScaleWidth 2.7279413823, msoFalse, msoScaleFromTopLeft
                .ScaleHeight 1.9971405658, msoFalse, msoScaleFromTopLeft
            End With
          
            With ActiveChart
                .SetElement (msoElementDataLabelTop)
                .SetElement (msoElementDataTableWithLegendKeys)

                ' Grafik başlığını seçin ve verileri atayın
                .ChartTitle.Select
                Selection.Caption = "='ANADOSYA'!B" & satirBaslangic
                
                .ChartArea.Select
            End With
          
            ChDir "C:\Users\homenar\Desktop\deneme"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "C:\Users\homenar\Desktop\deneme\" & Sheets("ANADOSYA").Range("B" & satirBaslangic) & ".pdf", Quality:= _
                xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            
            ActiveChart.Parent.Delete
          
            chartNumber = chartNumber + 1
            
            satirBaslangic = satirBaslangic + 11
        Next j
    Next i

End Sub

Denermisiniz

 

[Narhome]

Denermisiniz

Hocam emeğinize eline sağlık. Şöyle bir sıkıntı oldu ;
satırBitis değişkeni istediğimiz verileri çekmiyordu. Yani satirbitis 12,23,34,45 olarak gitmesi gerekiyor. Bu kodu uyguladığımda istediğimiz değerleri alamıyorduk. Bende sizin kodların üzerinden yola çıkarak bir değişiklik yaptım bu şekilde istediğimiz grafikleri sorunsuz şekilde şektik gibi duruyor tekrar teşekkür ederim.

Sub Makro1()
    
    Dim chartName As String
    Dim chartNumber As Integer
    Dim satirBaslangic As Integer
    Dim satirBitis As Integer
    
    chartNumber = 1
    satirBaslangic = 2
    satirBitis = 12
    For i = 1 To 1054 ' 11597 satırı 11'e böldüğümüzde 1054 kalan elde ederiz.
      
                  
            Range("D" & satirBaslangic & ":I" & satirBitis).Select
            
            chartName = "Grafik" & chartNumber
            
            ActiveSheet.Shapes.AddChart2(227, xlLine).Select
            
            ActiveChart.Parent.Name = chartName
            
            With ActiveSheet.Shapes(chartName)
                .IncrementLeft 89.1176377953
                .IncrementTop -210.8823622047
                .ScaleWidth 2.7279413823, msoFalse, msoScaleFromTopLeft
                .ScaleHeight 1.9971405658, msoFalse, msoScaleFromTopLeft
            End With
          
            With ActiveChart
                .SetElement (msoElementDataLabelTop)
                .SetElement (msoElementDataTableWithLegendKeys)

                ' Grafik başlığını seçin ve verileri atayın
                .ChartTitle.Select
                Selection.Caption = "='ANADOSYA'!B" & satirBaslangic
                
                .ChartArea.Select
            End With
          
            ChDir "C:\Users\homenar\Desktop\deneme"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "C:\Users\homenar\Desktop\deneme\" & Sheets("ANADOSYA").Range("B" & satirBaslangic) & ".pdf", Quality:= _
                xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            
            ActiveChart.Parent.Delete
          
            chartNumber = chartNumber + 1
            
            satirBaslangic = satirBaslangic + 11
            satirBitis = satirBitis + 11
        
    Next i

End Sub