AccessTr.neT

21 Adet Grafiği Vba Tek İmga Üzerinde Seçerek Göstermek

bir önceki konunuzda yaptığım uyarıyı gözardı etmişsiniz. çalışmanız sadece seçilen tablo/ay/yıl ile ilgili verileri alıyor oysa siz alınmamış tablo verilerinin de grafiğini göstermeye çalışıyorsunuz. o nedenle tekrar hatırlatayım seçili tabloya ait olmayan grafiklerin sonuçları hatalı çıkabilir.

Modül 1 deki fonksiyonu aşağıdaki ile değiştirip:

Function GrafikKaynak(TabloAdi As String, AyAdi As String, GrafAdi As String)

connection_open



sql1 = "select * from " & TabloAdi & " where format(tarih,'m.yyyy')='" & AyAdi & "';"

rsGrf.Open sql1, conn, adOpenKeyset, adLockPessimistic

    Worksheets(TabloAdi).Cells.Clear

    Worksheets(TabloAdi).Range("A1").CopyFromRecordset rsGrf



'hy ListView veri ekle



With grafik.ListView1

For i = 0 To rsGrf.Fields.Count - 1

.ColumnHeaders.Add , , rsGrf.Fields(i).Name



Next i

End With



If rsGrf.RecordCount > 0 Then rsGrf.MoveFirst





Dim lw_rec As ListItem

With grafik.ListView1



.ListItems.Clear



       Do While Not rsGrf.EOF

       Set lw_rec = .ListItems.Add(, , rsGrf.Fields(0).Value)



       For X = 1 To rsGrf.Fields.Count - 1

       lw_rec.SubItems(X) = IIf(IsNull(rsGrf.Fields(X).Value), "0", rsGrf.Fields(X).Value)

       Next X



      rsGrf.MoveNext

      Loop

    .FullRowSelect = True

    .Gridlines = True

    .View = lvwReport





End With



rsGrf.Close

conn.Close

'hy  UserForm Grafik ekleme________________________

Dim sTempFile As String

    Dim sChartName As String

    Dim oChart As Chart

   

 'BARAJ KOTU DEĞİŞİM GRAFİĞİ

    sTempFile = Environ("temp") & "\temp.gif"

    Debug.Print GrafAdi

   

   

    Set oChart = Worksheets("örnekgrafik").ChartObjects(CStr(GrafAdi)).Chart

   

    oChart.Export Filename:=sTempFile, FilterName:="GIF"

   

    grafik.Image3.Picture = LoadPicture(sTempFile)

'

    Kill sTempFile

MsgBox "bitti"

End Function

grafik formundaki CommandButton1_Click() kodunu aşağıdaki ile değiştirerek dener misiniz?

GrafikKaynak Me.ListBox2, Me.ListBox1 & "." & Me.txtYil, Me.ListBox3.Column(1)

Modül kedik kodlar bunlar bende garikleride ekledim 
Function GrafikKaynak(TabloAdi As String, AyAdi As String)
connection_open

sql1 = "select * from " & TabloAdi & " where format(tarih,'m.yyyy')='" & AyAdi & "';"
rsGrf.Open sql1, conn, adOpenKeyset, adLockPessimistic
    Worksheets(TabloAdi).Cells.Clear
    Worksheets(TabloAdi).Range("A1").CopyFromRecordset rsGrf

'hy ListView veri ekle

With grafik.ListView1
For i = 0 To rsGrf.Fields.Count - 1
.ColumnHeaders.Add , , rsGrf.Fields(i).Name

Next i
End With

If rsGrf.RecordCount > 0 Then rsGrf.MoveFirst


Dim lw_rec As ListItem
With grafik.ListView1

.ListItems.Clear

      Do While Not rsGrf.EOF
      Set lw_rec = .ListItems.Add(, , rsGrf.Fields(0).Value)

      For X = 1 To rsGrf.Fields.Count - 1
      lw_rec.SubItems(X) = IIf(IsNull(rsGrf.Fields(X).Value), "0", rsGrf.Fields(X).Value)
      Next X

      rsGrf.MoveNext
      Loop
    .FullRowSelect = True
    .Gridlines = True
    .View = lvwReport


End With

rsGrf.Close
conn.Close
'hy  UserForm Grafik ekleme________________________
Dim sTempFile As String
    Dim sChartName As String
    Dim oChart As Chart
 
 
    sTempFile = Environ("temp") & "\temp.gif"
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("BARAJ KOTU DEĞİŞİM GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("BARAJ HACMİ DEĞİŞİM GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("BARAJ AKTİF DOLULUK ORANI").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
    Set oChart = Worksheets("örnekgrafik").ChartObjects("BARAJ YAĞIŞ VE BUHARLAŞMA").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("FeCl3 SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("Al2(SO4)3 SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("PAC SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("POLİMER (SU) SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("KLOR SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("NaOH SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("KMnO4 SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("POLİMER (ÇAMUR) SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("KİREÇ SARFİYAT GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("ÇAMUR ÜRETİM GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("GİRİŞ DEBİSİ GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("ÇIKIŞ DEBİSİ GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("SU ALMA YAPISI ELEKTRİK").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("ARITMA TESİSİ ELEKTRİK").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
   
      Set oChart = Worksheets("örnekgrafik").ChartObjects("ÜRETİM ORTALAMASI GRAFİĞİ").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("SU ALMA YAPISI ÜRETİM").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 
    Set oChart = Worksheets("örnekgrafik").ChartObjects("ARITMA TESİSİ ÜRETİM").Chart
 
    oChart.Export Filename:=sTempFile, FilterName:="GIF"
 
    grafik.Image3.Picture = LoadPicture(sTempFile)
 
 

    Kill sTempFile
MsgBox "bitti"
End Function

Son attığınız modülü kullandığımda baraj tablosunun garfiklerini seçtiğimde gösteriyor ama diğerlerini göstemiyor. Diğer tabloların grafikleri seçtiğimde grafik.Image3.Picture = LoadPicture(sTempFile) hata alıyorum

Tamam dır grafik işlemi de çalışmakta. Yanlış seçim yaptıklarında programın arkasına atmasın mgsbox yanlış seçim diye uyarı nasıl verdire biliriz.

Gönderdiğim kodlara ekleme yapmayacaktınız kodu zaten liste3ten alacak şekilde yapmıştım.