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

beratkandil · 23 Ocak 2018

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.

Haluk · 23 Ocak 2018

Merhaba;

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

.

beratkandil · 23 Ocak 2018

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

Haluk · 23 Ocak 2018

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 ...

.

beratkandil · 24 Ocak 2018

o kadar araştırdım ama benzer bir duruma hiç rastlamadım bilgi sahibi olan arkadaşların yardımlarını rica ediyorum

levo26 · 24 Ocak 2018

Haluk' Alıntı:
Merhaba;

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

.

Merhaba Haluk bey,
Bahsettiğiniz TCMB güncel kurlarını tablonun üstüne üst bilgi olarak yazdırmak istersem hangi kodları kullanabilirim?

levo26 · 24 Ocak 2018

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

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

halit3 · 24 Ocak 2018

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.

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.

levo26 · 26 Ocak 2018

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.

Merhaba Halit bey,

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

halit3 · 26 Ocak 2018

levo26' Alıntı:
Merhaba Halit bey,

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

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.

Haluk · 26 Ocak 2018

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

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

beratkandil · 26 Ocak 2018

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

beratkandil · 26 Ocak 2018

çok teşekkür ederim hepinize ilginiz ve yardımlarınız için, selamınızı da ileteceğim

levo26 · 26 Ocak 2018

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.

Halit bey,

Altın üye olmadığından indiremiyorum. Dosya yükleme sitelerinden herhangi birine yükleyebilirmisiniz?

halit3 · 26 Ocak 2018

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

levo26 · 26 Ocak 2018

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

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

halit3 · 26 Ocak 2018

dosya silindi

levo26 · 29 Ocak 2018

halit3' Alıntı:
dosya silindi

Ne yapalım... Teşekkürler.. Canınız sağolsun.

halit3 · 29 Ocak 2018

levo26' Alıntı:
Ne yapalım... Teşekkürler.. Canınız sağolsun.

Merhaba siz eklediğim dosyayı indirmedinizmi

levo26 · 29 Ocak 2018

halit3' Alıntı:
Merhaba siz eklediğim dosyayı indirmedinizmi

Link yoktu..

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

beratkandil

Haluk

Özel Üye

beratkandil

Haluk

Özel Üye

beratkandil

levo26

levo26

halit3

Uzman

levo26

halit3

Uzman

Ekli dosyalar

Haluk

Özel Üye

beratkandil

beratkandil

levo26

halit3

Uzman

levo26

halit3

Uzman

levo26

halit3

Uzman

levo26