• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel üst bilgi kısmına makro ile resim ekleme

B

beratkandil

Katılım
22 Ocak 2018
Mesajlar
7
Excel Vers. ve Dili
excel 2010
Merhaba arkadaşlar yardımcı olabilirseniz sevinirim;

dosyayı yüklemeye çalıştım ama kurum bilgisayarı olduğu için engelledi yükleyemedim.

benim kur hesapladığım bir tablom var bu tablo sayfanın en altına gelecek şekilde yerleştirilmiş durumda. Yukarıda kalan boş kısma ise üst bilgiyle o günkü merkez bankası kur tablosunun resmini ekliyorum.
resimlere tarihi yazarak isim veriyorum yani 10 10 2018 gibi. Kur tarihini de bir hücreye yazıyorum 10/10/2018 gibi.

makro ile belirttiğim klasörde yer alan resmi hücreye girdiği tarihten ismini alarak üst bilgi olarak otomatik şekilde eklemesini nasıl sağlarım.

yani kur tarihi olarak giriş sayfası a1 gücresine 10/10/2018 yazdığımda 10 10 2018.jpg isimli resmi nasıl üst bilgi olarak eklerim. yardımcı olabilirseniz çok sevinirim.

şimdiden teşekkürler. İyi çalışmalar.
 
Merhaba;

Resim yerine, TCMB günlük kur tablosunu hücrelere yazdırmayı denesiniz daha iyi olmaz mı?

.
 
müdürümüz illa resmi merkez bankası verisi olacak diyor dediğiniz şekilde bir tablo yapmıştım ama kabul etmiyor. hata olur diyor, eski kafa zihniyeti değiştirmek biraz zor anlaşılan, yani el mahkum :(
 
Benim bahsettiğim de zaten TCMB'nin resmi internet sitesinden makro kodlarıyla alınacak kurlar.

Neyse, Müdürünüz istemiyorsa kendisi bilir ...

.
 
o kadar araştırdım ama benzer bir duruma hiç rastlamadım bilgi sahibi olan arkadaşların yardımlarını rica ediyorum
 
Haluk' Alıntı:
Merhaba;

Resim yerine, TCMB günlük kur tablosunu hücrelere yazdırmayı denesiniz daha iyi olmaz mı?

.
Genişletmek için tıkla ...

Merhaba Haluk bey,
Bahsettiğiniz TCMB güncel kurlarını tablonun üstüne üst bilgi olarak yazdırmak istersem hangi kodları kullanabilirim?
 
beratkandil' Alıntı:
o kadar araştırdım ama benzer bir duruma hiç rastlamadım bilgi sahibi olan arkadaşların yardımlarını rica ediyorum
Genişletmek için tıkla ...

Merhaba,

A1 hücresine istediğiniz resmi koyduktan sonra aşağıdaki kodlar işinizi görür..

Sub üstbilgi()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = [a1]
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub
 
beratkandil' Alıntı:
Merhaba arkadaşlar yardımcı olabilirseniz sevinirim;

dosyayı yüklemeye çalıştım ama kurum bilgisayarı olduğu için engelledi yükleyemedim.

benim kur hesapladığım bir tablom var bu tablo sayfanın en altına gelecek şekilde yerleştirilmiş durumda. Yukarıda kalan boş kısma ise üst bilgiyle o günkü merkez bankası kur tablosunun resmini ekliyorum.
resimlere tarihi yazarak isim veriyorum yani 10 10 2018 gibi. Kur tarihini de bir hücreye yazıyorum 10/10/2018 gibi.

makro ile belirttiğim klasörde yer alan resmi hücreye girdiği tarihten ismini alarak üst bilgi olarak otomatik şekilde eklemesini nasıl sağlarım.

yani kur tarihi olarak giriş sayfası a1 gücresine 10/10/2018 yazdığımda 10 10 2018.jpg isimli resmi nasıl üst bilgi olarak eklerim. yardımcı olabilirseniz çok sevinirim.

şimdiden teşekkürler. İyi çalışmalar.
Genişletmek için tıkla ...

Sorunuzu anlamak için yazıyorum döviz kurlarını alırken ilgili web sayfasının kapyalayarak resim olarak a1 hücresine yapıştırmakmı istiyorsunuz.
 
halit3' Alıntı:
Sorunuzu anlamak için yazıyorum döviz kurlarını alırken ilgili web sayfasının kapyalayarak resim olarak a1 hücresine yapıştırmakmı istiyorsunuz.
Genişletmek için tıkla ...

Merhaba Halit bey,

TCMB döviz kurlarını USD,EUR olarak resim formatında nasıl yapıştırabiliriz. (Makro ile)
 
levo26' Alıntı:
Merhaba Halit bey,

TCMB döviz kurlarını USD,EUR olarak resim formatında nasıl yapıştırabiliriz. (Makro ile)
Genişletmek için tıkla ...

Ekli dosyada bir adet userform mevcut orada takvim nesnesinden tarihi seç veri al düğmesine tıkla

Bu uygulama da WebBrowser nesnesi de kullanılmıştır.
 

Ekli dosyalar

beratkandil' Alıntı:
o kadar araştırdım ama benzer bir duruma hiç rastlamadım bilgi sahibi olan arkadaşların yardımlarını rica ediyorum
Genişletmek için tıkla ...

Berat Bey;

Aşağıdaki kodla, seçeceğiniz JPG veya PNG formatındaki resmi aktif sayfanın üst bilgi kısmında orta bölüme ekleyebilirsiniz.

Not: Müdürünüze de selamlarımı iletin :mrgreen:

Kod: 
Sub InsertImage()
    Dim myFile As Variant
    myFile = Application.GetOpenFilename(FileFilter:="Jpg (*.jpg),*.jpg,Png (*.png),*.png")
    If myFile <> False Then
        With ActiveSheet.PageSetup
            With .CenterHeaderPicture
                .Filename = myFile
                .Height = 70
                .Width = 120
            End With
            .CenterHeader = "&G"
            .Zoom = 100
            .AlignMarginsHeaderFooter = True
        End With
    End If
End Sub
 
Son düzenleme:
merkaz bankasının web sitesinde yer alan kur listesinin ekran görüntüsünü alıp bir klasöre kaydediyorum ve üst bilgi olarak oradan seçip excel sayfasına ekliyorum böylece sayfanın üst kısmına tamamen bu resim yerleşiyor bende altına avans hesaplamalarını koyuyorum. istediğim kur tarihini bir hücreye yazdığımda o tarihle isimlendirilmiş olan resmi üst bilgi olarak otomatik koysun yani hücreye resmi koymayayım ama isimini yazayım.

şöyle söyleyeyim a1 hücresine 01.01.2018 yazdığım zaman 01.01.2018.jpg resmini otomatik olarak üst bilgiye eklesin
 
çok teşekkür ederim hepinize ilginiz ve yardımlarınız için, selamınızı da ileteceğim :)
 
halit3' Alıntı:
Ekli dosyada bir adet userform mevcut orada takvim nesnesinden tarihi seç veri al düğmesine tıkla

Bu uygulama da WebBrowser nesnesi de kullanılmıştır.
Genişletmek için tıkla ...

Halit bey,

Altın üye olmadığından indiremiyorum. Dosya yükleme sitelerinden herhangi birine yükleyebilirmisiniz?
 
Ben başka sitelere dosya yüklemiyorum.

Siz kendiniz oluşturun dosyayı

Dosyada bulunması gereken sayfalar
Kod: 
data
Kod: 
veri

Dosyaya bir adet userform ekleyin userformun üstüne eklenecek nesneler

Kod: 
Calendar1_Click
CommandButton1_Click
Label1
WebBrowser1

kod:

Kod: 
Private Sub Calendar1_Click()
Tarih = Calendar1.Value

deg1 = Format(Val(Mid(Tarih, 1, 2)), "00")
deg2 = Format(Val(Mid(Tarih, 4, 2)), "00")
deg3 = Format(Val(Mid(Tarih, 7, 4)), "00")

url1 = "http://www.tcmb.gov.tr/kurlar/" & deg3 & deg2 & "/" & deg1 & deg2 & deg3 & ".xml"
Label1 = url1
WebBrowser1.Navigate Label1
End Sub

Private Sub CommandButton1_Click()

Dim Picture2 As Object
For Each Picture2 In Worksheets("data").Shapes
If Picture2.Type = 13 Then
Picture2.Delete
End If
Next Picture2


Dim Picture As Object
For Each Picture In Worksheets("veri").Shapes
If Picture.Type = 13 Then
Picture.Delete
End If
Next Picture

Worksheets("veri").Columns("A:P").UnMerge

Worksheets("veri").Columns("A:P").ClearContents
Worksheets("veri").Columns("A:P").Interior.Pattern = xlNone
Worksheets("veri").Columns("A:P").Borders(xlDiagonalDown).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlDiagonalUp).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeLeft).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeTop).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeBottom).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeRight).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlInsideVertical).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlInsideHorizontal).LineStyle = xlNone


WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER
WebBrowser1.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DONTPROMPTUSER


Worksheets("veri").Range("a1").PasteSpecial
Worksheets("veri").Columns("A:P").Font.Size = 10

Worksheets("veri").Columns("A:P").UnMerge
Worksheets("veri").Rows("1:67").EntireRow.AutoFit

hucre = Worksheets("veri").Cells(1, 1).Value
aranan = "Gösterge"

deg1 = Split(hucre, aranan)
If UBound(deg1) > 0 Then

Worksheets("veri").Cells(1, 1).Value = deg1(0) & " " & aranan
Worksheets("veri").Cells(2, 1).Value = deg1(1)
End If

aranan1 = "USD/TRY"
aranan2 = "EUR/TRY"
say = 3

For i = 7 To Worksheets("veri").Cells(Rows.Count, 1).End(3).Row
yer = Right(Worksheets("veri").Cells(i, 1).Value, 7)
If aranan1 = yer Or aranan2 = yer Then
Worksheets("veri").Range(Worksheets("veri").Cells(i, 1), Worksheets("veri").Cells(i, 7)).CopyPicture , xlBitmap 'xlPicture ',
Worksheets("data").Paste Destination:=Worksheets("data").Range("A" & say)
say = say + 3
End If
Next


MsgBox "işlem tamam"

End Sub


Private Sub UserForm_Initialize()

url1 = "http://www.tcmb.gov.tr/kurlar/today.xml"
Label1 = url1
WebBrowser1.Navigate Label1

End Sub
 
halit3' Alıntı:
Ben başka sitelere dosya yüklemiyorum.

Siz kendiniz oluşturun dosyayı

Dosyada bulunması gereken sayfalar
Kod: 
data
Kod: 
veri

Dosyaya bir adet userform ekleyin userformun üstüne eklenecek nesneler

Kod: 
Calendar1_Click
CommandButton1_Click
Label1
WebBrowser1

kod:

Kod: 
Private Sub Calendar1_Click()
Tarih = Calendar1.Value

deg1 = Format(Val(Mid(Tarih, 1, 2)), "00")
deg2 = Format(Val(Mid(Tarih, 4, 2)), "00")
deg3 = Format(Val(Mid(Tarih, 7, 4)), "00")

url1 = "http://www.tcmb.gov.tr/kurlar/" & deg3 & deg2 & "/" & deg1 & deg2 & deg3 & ".xml"
Label1 = url1
WebBrowser1.Navigate Label1
End Sub

Private Sub CommandButton1_Click()

Dim Picture2 As Object
For Each Picture2 In Worksheets("data").Shapes
If Picture2.Type = 13 Then
Picture2.Delete
End If
Next Picture2


Dim Picture As Object
For Each Picture In Worksheets("veri").Shapes
If Picture.Type = 13 Then
Picture.Delete
End If
Next Picture

Worksheets("veri").Columns("A:P").UnMerge

Worksheets("veri").Columns("A:P").ClearContents
Worksheets("veri").Columns("A:P").Interior.Pattern = xlNone
Worksheets("veri").Columns("A:P").Borders(xlDiagonalDown).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlDiagonalUp).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeLeft).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeTop).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeBottom).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlEdgeRight).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlInsideVertical).LineStyle = xlNone
Worksheets("veri").Columns("A:P").Borders(xlInsideHorizontal).LineStyle = xlNone


WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER
WebBrowser1.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DONTPROMPTUSER


Worksheets("veri").Range("a1").PasteSpecial
Worksheets("veri").Columns("A:P").Font.Size = 10

Worksheets("veri").Columns("A:P").UnMerge
Worksheets("veri").Rows("1:67").EntireRow.AutoFit

hucre = Worksheets("veri").Cells(1, 1).Value
aranan = "Gösterge"

deg1 = Split(hucre, aranan)
If UBound(deg1) > 0 Then

Worksheets("veri").Cells(1, 1).Value = deg1(0) & " " & aranan
Worksheets("veri").Cells(2, 1).Value = deg1(1)
End If

aranan1 = "USD/TRY"
aranan2 = "EUR/TRY"

say = 3

For i = 1 To Worksheets("veri").Cells(Rows.Count, 1).End(3).Row
If aranan1 = Worksheets("veri").Cells(i, 1).Value Or aranan2 = Worksheets("veri").Cells(i, 1).Value Then

Worksheets("veri").Range(Worksheets("veri").Cells(i, 1), Worksheets("veri").Cells(i, 7)).CopyPicture xlScreen, xlBitmap
Worksheets("data").Paste Destination:=Worksheets("data").Range("A" & say)
say = say + 3
End If
Next

MsgBox "işlem tamam"

End Sub


Private Sub UserForm_Initialize()

url1 = "http://www.tcmb.gov.tr/kurlar/today.xml"
Label1 = url1
WebBrowser1.Navigate Label1

End Sub
Genişletmek için tıkla ...

Halit Bey,

Userform olayını bilmiyorum. Test dosya oluşturup kodları uyarlamaya çalıştım .. Maalesef başarılı olamadım. Dosya ekte. Eğer mümkünse revize ederek mail atabilirmisiniz..

http://dosya.co/zvdta5t5yblo/deneme.xltm.html


le.erdogan@hotmail.com
 
dosya silindi
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst