• DİKKAT

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

Hücreyenin başına harf ekleyip resim çağırmak

Katılım
31 Mart 2010
Mesajlar
21
Excel Vers. ve Dili
excel 2007 Türkçe
Merhabalar

Bir tekstil firmesında çalışıyorum.Sentez adında mağaza yönetim programını kullanıyoruz.Sentezden ürünlerin raporlamak için excelde inceliyoruz.Sizden ricam stok kodlarının başına s harfini ekleyip resmini çağırabilicek bir makro yapmamda yardım edermisiniz ?
 

Ekli dosyalar

Merhabalar

Bir tekstil firmesında çalışıyorum.Sentez adında mağaza yönetim programını kullanıyoruz.Sentezden ürünlerin raporlamak için excelde inceliyoruz.Sizden ricam stok kodlarının başına s harfini ekleyip resmini çağırabilicek bir makro yapmamda yardım edermisiniz ?
Dosyanızı excel 2003 formatında yüklerseniz ve bir kaç resimde koyup winrar ile sıkıştırıp yollarsanız daha çabuk yanıt alabilirsiniz..:cool:
 
Öneri için teşekkür ederim.Dosyada 19 adet resim ve Örnek rapor dosyasının excel 2007 ve excel 2003 versiyonları mevcuttur.
 

Ekli dosyalar

Dosyanız ektedir.
Dosyanızın ve resimlerin ayni klasörde olması gerekiyor.
Resimlerin jpg formatında olması gerekiyor.
Resim görmek için A-L aralığında bir satıra tıklayınız.:cool:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\S" & Cells(Target.Row, "A").Value & ".jpg")
End Sub
 

Ekli dosyalar

evren bey yaptıgını görmemiştim
o daha güzel olmuş allah razı olsun arşive ekleyecem
 
Dosyanız ektedir.
Dosyanızın ve resimlerin ayni klasörde olması gerekiyor.
Resimlerin jpg formatında olması gerekiyor.
Resim görmek için A-L aralığında bir satıra tıklayınız.:cool:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\S" & Cells(Target.Row, "A").Value & ".jpg")
End Sub

evren bey bir soruda ben sorayım
secile sotok kodunu safta2 b15 hüçresine yazmak mümkünmü
 
evren bey bir soruda ben sorayım
secile sotok kodunu safta2 b15 hüçresine yazmak mümkünmü
Alttaki kodu ekleyiniz.:cool:
Kod:
Sheets("Sayfa2").range("B15").value=Range("A" & Target.Row).value
 
Sayın Evren Gizlen

Yolladığınız makro ve gönderdiğiniz dosya için çok teşekkür ederim.Gerçekten bu alanda uzmansınız :D Yolladıklarınız sorunumu büyük ölçüde hallediyor.Fakat sizden ufak bir ricam daha var.Resimlerin adresini \\192.168.2.10\Sentez\Shop\resim olarak gösterebilir misiniz ? Ve acaba resimleri ürünlerle aynı satıra koyabilmeniz mümkün mü ? Şimdiden çok teşekkür ederim :D
 
Sayın Gökhan bey

Sizede teşekkür ederim sorunumla ilgilendiğiniz için.
 
Sayın Evren Gizlen

Yolladığınız makro ve gönderdiğiniz dosya için çok teşekkür ederim.Gerçekten bu alanda uzmansınız :D Yolladıklarınız sorunumu büyük ölçüde hallediyor.Fakat sizden ufak bir ricam daha var.Resimlerin adresini \\192.168.2.10\Sentez\Shop\resim olarak gösterebilir misiniz ? Ve acaba resimleri ürünlerle aynı satıra koyabilmeniz mümkün mü ? Şimdiden çok teşekkür ederim :D
Önce resimi taşıma konusun uhalledelim.
Ekli dosyayı inceleyiniz.
Tıkladığınız satırda a sütununda gözüküyor resim.:cool:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\S" & Cells(Target.Row, "A").Value & ".jpg")
Image1.Left = Range("A" & Target.Row).Left
Image1.Top = Range("A" & Target.Row + 1).Top
End Sub
 

Ekli dosyalar

Sayın Evren Gizlen yardımlarınız için teşekkür ederim.Sizden bir ricam daha var.Resimlerin adresini \\192.168.2.10\Sentez\Shop\resim olarak gösterebilir misiniz ve resimleri ürünlerle aynı satıra koyabilmeniz mümkün mü ? ayrıca bu makroları başka bir excel tablosuna nasıl uygularım ?
 
Sayın Evren Gizlen yardımlarınız için teşekkür ederim.Sizden bir ricam daha var.Resimlerin adresini \\192.168.2.10\Sentez\Shop\resim olarak gösterebilir misiniz ve resimleri ürünlerle aynı satıra koyabilmeniz mümkün mü ? ayrıca bu makroları başka bir excel tablosuna nasıl uygularım ?
Ekli dosyayı incelermisiniz.:cool:
Sonucu bekliyorum.Bu serverde bir adresmi?
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A8:L" & Cells(65536, "A").End(xlUp).Row)) Is Nothing Then Exit Sub
On Error Resume Next
Range("A8:L65536").Interior.ColorIndex = xlNone
Range("A8:L65536").Font.Color = vbBlack
Range("A8:L65536").Font.Bold = False
Range("A" & Target.Row & ":L" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":L" & Target.Row).Font.Bold = True
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Image1.Left = Range("A1").Left
Image1.Top = Target.Top + Target.Height
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture("\\192.168.2.10\Sentez\Shop\resim\S" & _
Cells(Target.Row, "A").Value & ".jpg")
End Sub
 

Ekli dosyalar

Sonuç harika :D Evet ağdaki bir server.Sayın Evren bu makroyu başka bir excel dosyasına nasıl uygularım ?
 
Sonuç harika :D Evet ağdaki bir server.Sayın Evren bu makroyu başka bir excel dosyasına nasıl uygularım ?
Kullanacağınız dosyada kullanacağınız sayfada sayfa sekmesine sağ tıklayın.
Kod görüntüle'yi tıklayın.
Açılan modül sayfasına bu kodları yapıştırın.
VBE penceresini kapatın.
İşlem tamamdır.:cool:
 
Sayın Gizlen sizin yaptığınız dosyada sorun olmuyor ama kendi oluşturduğum dosyada sorun yaşıyorum.Yaptığım dosyaları ekte yolladım.Yardımcı olabilir misiniz ?
 

Ekli dosyalar

Sayın Gizlen sizin yaptığınız dosyada sorun olmuyor ama kendi oluşturduğum dosyada sorun yaşıyorum.Yaptığım dosyaları ekte yolladım.Yardımcı olabilir misiniz ?
Bende 2007 yok.
2003 formatında yüklerseniz bakarım.:cool:
 
Geri
Üst