• DİKKAT

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

Resim indirme

  • Konbuyu başlatan Konbuyu başlatan Lanvin
  • Başlangıç tarihi Başlangıç tarihi
L

Lanvin

Katılım
10 Nisan 2008
Mesajlar
42
Excel Vers. ve Dili
EXCEL 2007 / TR
Merhaba,

Aşağıda resimlerini yüklediğim sorum için yanıt arıyorum.
Yardımcı olabilirmisiniz?

Yapmaya çalıştığım şu 1. çalışma sayfasında her hangi bir hücreye veya nesneye tıklayarak ona köprüledeğim 2. çalışma sayfasındaki resmi farklı kaydebilmek.

İşlem tamamlandığında RESİMLER sayfası gizli konumda olacak.
Köprü ile o sayfadan resim çekmek istiyorum.

Eğer başka veya farklı bir uygulama varsa yönlendirmelerinizi de bekliyorum.

Teşekkürler..
 

Ekli dosyalar

  • 1.jpg
    1.jpg
    102 KB · Görüntüleme: 27
  • 2.jpg
    2.jpg
    95 KB · Görüntüleme: 12
Excel ile resim indirme indirlilen resimlerin adını değiştirme

merhaba arkadaşlar
Excel.web.tr excel konusunda başvurduğum ve çoğu zamanda aradığımı bulduğum bir site web master e çok teşekkür ederim.
benim sorunum şu:
sitemde bulunan ve linklerini bildiğim binlerce ürün resimi var. bu resim linklerimi kendim siteden alabiliyorum.
göndermiş olduğum örnek dosyada 1.sütunda ürün resim linkleri 2.sütunda o ürünün stok kodları var.ben excele örneğin ürün resim linklerini ve stok kodlarını yüklediğim zaman ürün resim linkini açacak resim adını yanındaki stok adı yapıp masa üstünde belirttiğim dosyaya kayıt edecek, sonra alttaki linki açıp aynı şekilde o resminde adını yanındaki stok kodu.jpg olarak kayıt edecek bu böyle son linke kadar devam edip hepsinin resimlerini indirecek.

böyle bir macro var mı? varsa lütfen linkini verin.
yoksa böyle bir macro yazılabilir mi?

yardımcı olacağınız düşüncesi ile

saygılarımla
 

Ekli dosyalar

Dahah önce sitede paylaşmıştım.

Deneyiniz;
Kod: 
Sub Evn()
    Dim i As Integer
    Dim WShel As Object
    Dim a As String

    basla = Timer
    Set WShel = CreateObject("WScript.Shell")
    a = WShel.SpecialFolders("Desktop")

    Const MsgText = "Dosyalar İndirilsin mi ?"
    Const MsgHdr = "İnidiriliyor..."
    If MsgBox(MsgText, vbYesNo Or vbMsgBoxRtlReading Or vbExclamation, MsgHdr) _
        = vbYes Then
    MkDir (a & "\Evn Download")
    For i = 2 To Range("A65536").End(3).Row
    Cells(i, "C").Value = Right(Cells(i, "A"), 3)
    URL$ = Cells(i, "A").Value
    dosya$ = a & "\Evn Download" & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value
    DownloadFile URL$, dosya$
    'CreateObject("Wscript.shell").Run """" & dosya$ & """" - Dosyayı çalıştır...
    Next i
    End If
    
    bitir = Timer - basla
    MsgBox "İndirme işlemi " & Format(bitir, "00:00:00.00") & " sürede tamamlanmıştır. ", _
     vbInformation + vbMsgBoxRtlReading, "Www"
    i = Empty
    a = vbNullString
    Set WShel = Nothing
End Sub

Function DownloadFile(ByVal URL$, ByVal LocalPath$) As Boolean
    Dim XMLHTTP, ADOStream, FileName
    On Error Resume Next: Kill LocalPath$
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
    XMLHTTP.send
    If XMLHTTP.statustext = "OK" Then
    Set ADOStream = CreateObject("ADODB.Stream")
    ADOStream.Type = 1: ADOStream.Open
    ADOStream.Write XMLHTTP.responseBody
    ADOStream.SaveToFile LocalPath$, 2
    ADOStream.Close: Set ADOStream = Nothing
    DownloadFile = True
    Else
    MsgBox "Bağlantı sağlanamadı", vbInformation, "Hata !"
    End If
    Set XMLHTTP = Nothing
End Function
 
üst üste ikinci indirme yapılınca Patch File error veriyor buna bir çözüm var mı ?
 
Oluşturulan klasörü silip yeniden ekleyebilirsiniz. Ya da aynı klasör içine kaydedebilirsiniz. Ya da her seferinde farklı klasör içine kaydedebilirsiniz. vs. vs. vs.

Sitede bu konuda örnekler var.
 
Son düzenleme:
Merhaba Murat bey
size ne kadar teşekkür etsem azdır.
çok saolun işimi süper halletti. ve çok hızlı çalışıyor. ben bu işleri aylarca uğraşsam bitiremezdim. dakikada halletti

sağolun
 
Bilginiz olsun: sadece resimleri değil, tüm dosyaları indirebilirsiniz...

İyi akşamlar...
 
Murat bey Şu evn download klasöründe dosya varsa msgbox > "klasör dolu " yoksa sorgusuz devam et komutu ekleyebilirmisiniz size zahmet olmazsa ?
 
Son düzenleme:
snx111' Alıntı:
Murat bey Şu evn download klasöründe dosya varsa msgbox > "klasör dolu " yoksa sorgusuz devam et komutu ekleyebilirmisiniz size zahmet olmazsa ?
Genişletmek için tıkla ...

Murat beyin koduna küçük ilaveler yaptım.
Klasör oluşturma işlemide tamam

Kod: 
Sub Evn()
Dim i As Integer
basla = Timer
Const MsgText = "Dosyalar İndirilsin mi ?"
Const MsgHdr = "İnidiriliyor..."
If MsgBox(MsgText, vbYesNo Or vbMsgBoxRtlReading Or vbExclamation, MsgHdr) = vbYes Then
Klasor = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Evn Download"
If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor) = False Then
MkDir (Klasor)
End If
For i = 2 To Range("A65536").End(3).Row
Cells(i, "C").Value = Right(Cells(i, "A"), 3)
URL$ = Cells(i, "A").Value
Dosya$ = Klasor & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya$) = True Then
MsgBox Dosya$ & Chr(10) & Chr(10) & "Bu dosya var"
Else
DownloadFile URL$, Dosya$
End If
'CreateObject("Wscript.shell").Run """" & dosya$ & """" - Dosyayı çalıştır...
Next i
End If
bitir = Timer - basla
MsgBox "İndirme işlemi " & Format(bitir, "00:00:00.00") & " sürede tamamlanmıştır. ", _
vbInformation + vbMsgBoxRtlReading, "Www"
i = Empty
End Sub
 
 
Function DownloadFile(ByVal URL$, ByVal LocalPath$) As Boolean
    Dim XMLHTTP, ADOStream, FileName
    On Error Resume Next: Kill LocalPath$
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
    XMLHTTP.send
    If XMLHTTP.statustext = "OK" Then
    Set ADOStream = CreateObject("ADODB.Stream")
    ADOStream.Type = 1: ADOStream.Open
    ADOStream.Write XMLHTTP.responseBody
    ADOStream.SaveToFile LocalPath$, 2
    ADOStream.Close: Set ADOStream = Nothing
    DownloadFile = True
    Else
    MsgBox "Bağlantı sağlanamadı", vbInformation, "Hata !"
    End If
    Set XMLHTTP = Nothing
End Function
 
Merhaba Halit Bey, ilgilendiğiniz için teşekkür ederim.

İyi akşamlar...
 
Murat OSMA' Alıntı:
Bilginiz olsun: sadece resimleri değil, tüm dosyaları indirebilirsiniz...

İyi akşamlar...
Genişletmek için tıkla ...


Murat bey kodları biraz inceledim inecek dosyayı kendi ismiyle indiremiyoruz ;
inecek dosyanın uzantısınıda belirtmek gerekiyor normal downloader gibi çalışması için kodu modifiye edermisiniz bu kodlamanın bu yapısından anlamıyorum malesef..
 
9 nolu mesajdaki kodun bu bölümü yerine

Kod: 
Dosya$ = Klasor & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value

Bunu denermisiniz.

Kod: 
Dosya$ = Klasor & "\" & Right(URL$, InStr(1, StrReverse(URL$), "/", vbTextCompare) - 1)

Not: Dosyanın tam adresi zaten A sutünunda var.
 
Son düzenleme:
Merhaba Halit Hocam bir örnek excel dosyası ile örneklendirmeniz mümkünmüdür.Sanırım yukarıdaki dosya silinmiş.
Ben yaptığımda Bağlantı Sağlanamadı hatası alıyorum.
Teşekkür ederim
 
hocam merhabalar ben excel de acemi biri olduğumu söyleyerek başlayayım söze.
elimde a sütununda fotoğraf linkleri ve b sütununda barkodları olan kitap1 adında bir dosyam var.
bu fotoğrafları barkodların ismini vererek pc ye kaydetmek istiyorum.
yukarıda kodlar var ama indirme yerini nereye yazacağım. makroyu nasıl uygulayacağımı, kodları ne yapacağımı bilmiyorum
yardım ederseniz çok sevinirim.
ilgilendiğiniz için şimdiden teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst