Excel Forum


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama



Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 02-08-2010, 15:24   #1
ethem.belen
 
Giriş: 16/02/2010
Şehir: bahçelievler
Mesaj: 5
Excel Vers. ve Dili:
2007 türkçe
Varsayılan MAcro ile Excel'e resim çekme sorunu

Merhaba arkadaşlar, Bir üretim firmasında çalışıyorum. Nerdeyse bütün günüm excele resim yapıştırmakla geçiyor. Ekte bir excel dosyası ve bir klasör(Resim) ekledim. Resim klasöründeki resimleri excel dosyasındaki belirtiğim yere sadece üst kısımdaki yere ürün kodunu yazarak ürün resmini excel cekmem gerekiyor. Yapılmaış bir örnek var fakat diğer kutucuklarada aynı mantıkta resim çekebilmem gerekiyor. Yardımcı olabilirseniz çok müteşekkir olurum. Şimdiden teşekkürler..
Eklenmiş Dosyalar
Dosya Türü: rar ÜRETİM TAKİP.rar (1.50 MB, 52 Görüntülenme)
ethem.belen Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-08-2010, 17:15   #2
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,828
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

Eklediğiniz dosya hatalıdır, tekrar ekleyiniz.
__________________
FORUM KURALLARI



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan
Levent Menteşoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-08-2010, 17:24   #3
İdris SERDAR
Moderatör
 
İdris SERDAR kullanıcısının avatarı
 
Giriş: 21/10/2005
Mesaj: 12,791
Excel Vers. ve Dili:
Excel, 2013 - İngilizce
Varsayılan

.

Dosyanız açılmıyor.

Buradaki dosyaları inceleyin.

http://www.excel.web.tr/showthread.php?t=22790

.
__________________
Çalışmalarımı görmek için:

http://www.excelgurusu.com/

İdris SERDAR
İdris SERDAR Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-08-2010, 18:42   #4
ethem.belen
 
Giriş: 16/02/2010
Şehir: bahçelievler
Mesaj: 5
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Merhaba arkadaşlar, Bir üretim firmasında çalışıyorum. Nerdeyse bütün günüm excele resim yapıştırmakla geçiyor. Ekte bir excel dosyası ve bir klasör(Resim) ekledim. Resim klasöründeki resimleri excel dosyasındaki belirtiğim yere sadece üst kısımdaki yere ürün kodunu yazarak ürün resmini excel cekmem gerekiyor. Yapılmaış bir örnek var fakat diğer kutucuklarada aynı mantıkta resim çekebilmem gerekiyor. Yardımcı olabilirseniz çok müteşekkir olurum. Şimdiden teşekkürler...
AÇILABİLİR FORMATI EKLEDİM TEŞEKKÜRLER
Eklenmiş Dosyalar
Dosya Türü: rar ÜRETİM TAKİP.rar (326.8 KB, 81 Görüntülenme)
ethem.belen Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-08-2010, 21:49   #5
ethem.belen
 
Giriş: 16/02/2010
Şehir: bahçelievler
Mesaj: 5
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Makro konusunda yardımcı olabilecek arkadaşımız yok galiba
ethem.belen Çevrimdışı   Alıntı Yaparak Cevapla
Eski 02-08-2010, 23:11   #6
Evolver
 
Giriş: 26/02/2010
Mesaj: 42
Excel Vers. ve Dili:
Office 2003 Türkçe
Varsayılan

ethem bey

aşağıdaki kodları sayfa1 in kod bölümüne yapıştırın ve resimlerin yolunu kendinize göre ayarlayın.
kodu çalıştırdığınızda resimlerin eklendiğini göreceksiniz
ama hiçbir denetim yaptırmadım
mesela resimlerin ebatları büyükse hücrelerden taşacak
bence bir bakın ondan sonra üzerinde çalışalım
kodlar:
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub resimekle()
Dim i As Integer
Dim j As Integer
Dim res As String
On Error Resume Next
For i = 1 To 601 Step 20
For j = 3 To 17 Step 7
res = "D:\resimler\" & Cells(i, j).Value & ".jpg"
Cells(i, j).Offset(1, 0).Select
ActiveSheet.Pictures.Insert res
Next j
Next i
MsgBox "resimler eklendi"
End Sub
Evolver Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-08-2010, 00:26   #7
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 18,842
Excel Vers. ve Dili:
OFFICE 2003 PRO TR OFFICE 2013 PRO TR
Varsayılan

Selamlar,

Alternatif olarak aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz.

Kod hücredeki "Model No" ya göre çalışmaktadır. Hata oluşmaması için koda eklemeler yaptım. Hücre zemin rengi kahverengi ise ve hücrenin solundaki hücrede "MODEL:" yazıyorsa kod çalışacaktır.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Resim As OLEObject
    Dim Yeni_Resim As OLEObject
    Dim Adres As Range
    Dim Dosya_Yolu As String
    Dim Resim_Adı As String
    
    If Intersect(Target, [C:C,J:J,Q:Q]) Is Nothing Then Exit Sub
    If Target.Interior.ColorIndex <> 40 Or Target = "" Or Not IsNumeric(Target) Then Exit Sub
    If Target.Offset(0, -2) <> "MODEL:" Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Dosya_Yolu = ThisWorkbook.Path & "\RESİMLER\"
    Resim_Adı = Target.Value & ".jpg"
    Set Adres = Range(Target.Offset(1, -2).Address, Target.Offset(14, 0).Address)
    
    If ActiveSheet.Shapes.Count > 0 Then
        For Each Resim In ActiveSheet.OLEObjects
            If Not Intersect(Range(Resim.TopLeftCell.Address & ":" & Resim.BottomRightCell.Address), Adres) Is Nothing Then
                Resim.Delete
            End If
        Next
    End If
    
    Set Yeni_Resim = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=Adres.Left, Top:=Adres.Top, Width:=Adres.Width, Height:=Adres.Height)
    
    With Yeni_Resim
        .Top = Adres.Top
        .Left = Adres.Left
        .Height = Adres.Height
        .Width = Adres.Width
        .Object.PictureSizeMode = fmPictureSizeModeStretch
    End With
    
    If Dir(Dosya_Yolu & Resim_Adı) <> "" Then
        Yeni_Resim.Object.Picture = LoadPicture(Dosya_Yolu & Resim_Adı)
    Else
        Yeni_Resim.Object.Picture = LoadPicture(Dosya_Yolu & "Stok_Resmi_Yok.jpg")
    End If
    
    Application.ScreenUpdating = True
End Sub
Eklenmiş Dosyalar
Dosya Türü: rar ÖRNEK.rar (341.5 KB, 246 Görüntülenme)
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimiçi   Alıntı Yaparak Cevapla
Eski 03-08-2010, 08:39   #8
ethem.belen
 
Giriş: 16/02/2010
Şehir: bahçelievler
Mesaj: 5
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Üstat Allah razı olsun, supersin. Allah ne muradın varsa versin. Daha diyebilirimki gerçekten çok teşekkürler. Beni nasıl bir yükten kurtardınız bilemezsiniz.Sayılar...
EVOLER üstat sizede teşekkür ederim. Koray AYHAN Beyin hazırladığı tam sorumun cevabı,hatta fazlası var.İlginize tekrar teşekkür ederim
ethem.belen Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-08-2010, 08:43   #9
Evolver
 
Giriş: 26/02/2010
Mesaj: 42
Excel Vers. ve Dili:
Office 2003 Türkçe
Varsayılan

eee daha onlardan öğrenecek çok şeyimiz var
hakkaten takdire şayan bir çalışma
ellerine sağlık uzmanım
Evolver Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-08-2010, 09:17   #10
Evolver
 
Giriş: 26/02/2010
Mesaj: 42
Excel Vers. ve Dili:
Office 2003 Türkçe
Varsayılan

eğer korhan hocam ilgilenirse bu vesileyle kendisine birşey sormak istiyorum (intersect i anlamak adına)

a) If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
ifadesi ile
b) If Target.Column <> 3 Then Exit Sub
ifadesi arasındaki fark nedir
Evolver Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 06:50


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.


Bahis Forum - Define - Çorlu Kamera - Çorlu Petek Temizleme - Site Yönetimi - TYPO3 Türkiye - 2015 Fuar - Çorlu Mimarlık - Çorlu Hotel - Rotary Web Sitesi - Çorlu Jeneratör - Shell Yağları - Excel Eğitimi - Çorlu Bilgisayar - ÇErkezköy Otelleri - Çorlu Otelleri - Çorlu Oto Lastik - Hurda Demir - Beyaz Baskı
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden