Skip to main content

AccessTr.neT


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

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

Çözüldü #1
21 Adet Grafiği Vba Tek İmga Üzerinde Seçerek Göstermek
.rar Aylık Faliyet Programı_hy2.rar (Dosya Boyutu: 3,38 MB | İndirme Sayısı: 3)
Cevapla
#2
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:

Visual Basic Code
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?

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

Cevapla
#3
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
Cevapla
#4
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
Son Düzenleme: 19/08/2020, 15:22, Düzenleyen: merttr07.
Cevapla
#5
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.
Cevapla
#6
Gönderdiğim kodlara ekleme yapmayacaktınız kodu zaten liste3ten alacak şekilde yapmıştım.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da