vba ağdan resim çekme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

vba ağdan resim çekme

İleti#1)  sener_izmir » 08 Şub 2018 15:41

Merhaba; Excel VBA da satırlarıma otomatik düşey ara ile aynı klasördeki resimleri getirebiliyorum ancak bir ağ surucusundeki dizinden naptırsam getiremiyorum.

ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg"

"\\3dnas\urun_foto" bu kısmı naptıysam çalıştıramadım. Aslında bir uzak sunucudan çektirsem çok daha fazla işime gelir. Yardımcı olabilecek arkadaşlara şimdiden Teşekkür. ederim.
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: vba ağdan resim çekme

İleti#2)  sener_izmir » 08 Şub 2018 15:42

sener_izmir yazdı:Merhaba; Excel VBA da satırlarıma otomatik düşey ara ile aynı klasördeki resimleri getirebiliyorum ancak bir ağ surucusundeki dizinden naptırsam getiremiyorum.

ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg"

"\\3dnas\urun_foto" bu kısmı naptıysam çalıştıramadım. Aslında bir uzak sunucudan çektirsem çok daha fazla işime gelir. Yardımcı olabilecek arkadaşlara şimdiden Teşekkür. ederim.


kod kısmının tamamı

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub

On Error GoTo çıkış

ActiveSheet.DrawingObjects.Delete
'Resim Yolunun bulunması

ActiveSheet.DrawingObjects.Delete

Dim ResimYolu, Hata As Variant
Dim resim As Object
For satır = 10 To 250

ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg"


'Resmi Oluştur

Set resim = ActiveSheet.Pictures.Insert(ResimYolu)


With Range("a" & satır)
resim.Top = .Top
resim.Height = .Height
resim.Left = .Left
resim.Width = .Width

End With

Next satır
çıkış:

End Sub
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: vba ağdan resim çekme

İleti#3)  askmadige34 » 08 Şub 2018 15:46

ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg" satırının yerine ağ sürününüzün tam adresi ve resmin adını (& Range("b" & satır) & ".jpg") ekleyip deneyin.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1523
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: vba ağdan resim çekme

İleti#4)  hemso41 » 08 Şub 2018 16:00

Kod: Tümünü seç
ResimYolu = "\\BilgiIslem-2\Users\Public\Pictures\Sample Pictures\" & Range("a1")

gibi yazmanız lazım
Örnekte;
BilgiIslem-2 isimli pcden resim alıyor. (Dosya Paylaşımlarının yapıldığı kabul edilerek)
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: vba ağdan resim çekme

İleti#5)  sener_izmir » 08 Şub 2018 16:14

hemso41 yazdı:
Kod: Tümünü seç
ResimYolu = "\\BilgiIslem-2\Users\Public\Pictures\Sample Pictures\" & Range("a1")

gibi yazmanız lazım
Örnekte;
BilgiIslem-2 isimli pcden resim alıyor. (Dosya Paylaşımlarının yapıldığı kabul edilerek)


Teşekkür ederim Çalıştı :)
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: Cevap: vba ağdan resim çekme

İleti#6)  sener_izmir » 08 Şub 2018 16:15

askmadige34 yazdı:ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg" satırının yerine ağ sürününüzün tam adresi ve resmin adını (& Range("b" & satır) & ".jpg") ekleyip deneyin.


Cevabınız için Teşekkürler
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: vba ağdan resim çekme

İleti#7)  sener_izmir » 12 Şub 2018 19:31

Merhaba Aşağıdaki kodlar düzgün çalışmakta ancak resim yok öğesi For satır = 10 To 100 belirttiğim gibi 100 e kadar otomatik atıyor ancak ben sadece B sütününda ürün seçimi yapılmışsa resimyok.jpg yi bastırsın istiyorum. Nasıl bir fonksiyon düzelmesi yapabilirim. Diğer türlü ürün seçili olmasa bile 100 e kadar gidiyor ya resimleri elle silmem gerekiyor yada macroya girip satır sayısını düzeltmem gerekiyor. Teşekkür ederim.

Public Function DosyaVarmi(dosyayolu As String) As Boolean
On Error GoTo Çıkış
If Not Dir(dosyayolu, vbDirectory) = vbNullString Then DosyaVarmi = True

Çıkış:
On Error GoTo 0
End Function

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [b:b]) Is Nothing Then Exit Sub


On Error GoTo Çıkış:

ActiveSheet.DrawingObjects.Delete

Dim ResimDosyaYolu As String
Dim Resim As Object

For satır = 10 To 100

ResimDosyaYolu = "\\3dnas\urun_foto\" & Range("b" & satır) & ".jpg"

If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = "\\3dnas\urun_foto\" & Range("b" & satır) & ".jpg"
Else
ResimDosyaYolu = "\\3dnas\urun_foto" & "\resimyok.jpg"
End If

Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
With Range("a" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With

Next satır

Çıkış:

End Sub
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: vba ağdan resim çekme

İleti#8)  askmadige34 » 12 Şub 2018 19:49

Bu tarz işlemlerde öncelikle resimler temizlenip sonra ekleme yapılırsa daha sağlıklı sonuç alınır.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1523
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Cevap: vba ağdan resim çekme

İleti#9)  sener_izmir » 12 Şub 2018 20:00

askmadige34 yazdı:Bu tarz işlemlerde öncelikle resimler temizlenip sonra ekleme yapılırsa daha sağlıklı sonuç alınır.
rler

teşekkürler.
Kullanıcı avatarı
sener_izmir
 
Adı Soyadı:Şener AYDIN
Kayıt: 23 Arl 2010 16:49
Konum: izmir
Meslek: yok
Yaş: 36
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir

Cevap: vba ağdan resim çekme

İleti#10)  askmadige34 » 12 Şub 2018 21:33

Rica ederim.Örnek dosyanız olsa idi daha fazla yardımcı olunabilirdi.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1523
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: vba ağdan resim çekme

İleti#11)  cglrkltfn » 10 May 2018 18:35

Merhabalar

Benimde aynı konuda bir problemim mevcut. Yapmak istediğim şudur. Userformda resim ekle butonuna bastığımızda altındaki kutucuğa istediğim klasörden resim ekleyerek, kaydet butonuna bastığımda ise, sayfa1 deki "I" sütununa eklemesidir.
Örnek dosyam ektedir.

Konu ile ilgili desteğinizi rica ediyorum.

Şimdiden teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
cglrkltfn
Yeni Başlamış
 
Kayıt: 20 Nis 2016 09:39
Meslek: İş Geliştirme
Yaş: 30
İleti: 24
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İStanbul / Beylikdüzü

Cevap: vba ağdan resim çekme

İleti#12)  hemso41 » 11 May 2018 00:07

resimekle butonunun click yordamını aşağıdaki gibi güncellemen yeterli olacaktır.
Kod: Tümünü seç
Private Sub Kaydet_Click()
If TextBox2 <> Empty Then
If TextBox3 <> Empty Then
If TextBox4 <> Empty Then
If TextBox5 <> Empty Then
If TextBox6 <> Empty Then
If TextBox7 <> Empty Then
If TextBox8 <> Empty Then
   ibs = Range("A65536").End(3).Row + 1
               
                                    TextBox1.Text = ibs - 1
                                Cells(ibs, 1) = ibs - 2
                                Cells(ibs, 2) = TextBox2.Value
                                Cells(ibs, 3) = CDate(TextBox3.Value)
                                Cells(ibs, 4) = TextBox4.Value
                                Cells(ibs, 5) = TextBox5.Value
                                Cells(ibs, 6) = TextBox6.Value
                                Cells(ibs, 7) = TextBox7.Value
                                Cells(ibs, 8) = TextBox8.Value
                                If resim <> "" Then
                               
                                            With ActiveSheet.Pictures.Insert(resim)
                                                            With .ShapeRange
                                                                .LockAspectRatio = msoTrue
                                                                .Width = 75
                                                                .Height = 100
                                                            End With
                                                            .Left = ActiveSheet.Cells(ibs, 9).Left
                                                            .Top = ActiveSheet.Cells(ibs, 9).Top
                                                            .Placement = 1
                                                            .PrintObject = True
                                                End With
                End If

For i = 2 To 8
Controls("TExtbox" & i).Value = ""
Next

Else

MsgBox "AÇIKLAMA giriniz"

End If

Else

MsgBox "NUMUNE SONRASI İPLİK GR giriniz"

End If

Else

MsgBox "NUMUNE ÖNCESİ İPLİK GR giriniz"

End If

Else

MsgBox "TERMİN SÜRESİ giriniz"

End If

Else

MsgBox "MAKİNE İĞNE SAYISI giriniz"

End If

Else

MsgBox "İPLİK KODUNUZ giriniz"

End If

Else

MsgBox "İŞLEM TARİHİ giriniz"

End If


End Sub
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: vba ağdan resim çekme

İleti#13)  hemso41 » 11 May 2018 00:10

öncelikle kod satırının en üstüne resim adında global bir değişken tanımlıyoruz
Kod: Tümünü seç
Dim resim as string

Resimekle butonu
Kod: Tümünü seç
Private Sub CommandButton3_Click()
    resim = Application.GetOpenFilename(FileFilter:="Pictures,*.jpg", Title:="Resim Seçiniz", MultiSelect:=False)
        If resim <> "False" Then
            Image1.Picture = LoadPicture(resim)
        End If
End Sub

kaydet butonun
Kod: Tümünü seç
Private Sub Kaydet_Click()
If TextBox2 <> Empty Then
If TextBox3 <> Empty Then
If TextBox4 <> Empty Then
If TextBox5 <> Empty Then
If TextBox6 <> Empty Then
If TextBox7 <> Empty Then
If TextBox8 <> Empty Then
   ibs = Range("A65536").End(3).Row + 1
               
                                    TextBox1.Text = ibs - 1
                                Cells(ibs, 1) = ibs - 2
                                Cells(ibs, 2) = TextBox2.Value
                                Cells(ibs, 3) = CDate(TextBox3.Value)
                                Cells(ibs, 4) = TextBox4.Value
                                Cells(ibs, 5) = TextBox5.Value
                                Cells(ibs, 6) = TextBox6.Value
                                Cells(ibs, 7) = TextBox7.Value
                                Cells(ibs, 8) = TextBox8.Value
                                If resim <> "" Then
                               
                                            With ActiveSheet.Pictures.Insert(resim)
                                                            With .ShapeRange
                                                                .LockAspectRatio = msoTrue
                                                                .Width = 75
                                                                .Height = 100
                                                            End With
                                                            .Left = ActiveSheet.Cells(ibs, 9).Left
                                                            .Top = ActiveSheet.Cells(ibs, 9).Top
                                                            .Placement = 1
                                                            .PrintObject = True
                                                End With
                End If

For i = 2 To 8
Controls("TExtbox" & i).Value = ""
Next

Else

MsgBox "AÇIKLAMA giriniz"

End If

Else

MsgBox "NUMUNE SONRASI İPLİK GR giriniz"

End If

Else

MsgBox "NUMUNE ÖNCESİ İPLİK GR giriniz"

End If

Else

MsgBox "TERMİN SÜRESİ giriniz"

End If

Else

MsgBox "MAKİNE İĞNE SAYISI giriniz"

End If

Else

MsgBox "İPLİK KODUNUZ giriniz"

End If

Else

MsgBox "İŞLEM TARİHİ giriniz"

End If


End Sub
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: vba ağdan resim çekme

İleti#14)  cglrkltfn » 11 May 2018 09:02

Merhaba
Dediğiniz gibi yaptım fakat; resimekle kodlarında Image1.Picture = LoadPicture(resim) olarak hata veriyor.

Dosyayı ekte gönderiyorum. Kontrol edebilirmisiniz.

TEşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
cglrkltfn
Yeni Başlamış
 
Kayıt: 20 Nis 2016 09:39
Meslek: İş Geliştirme
Yaş: 30
İleti: 24
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İStanbul / Beylikdüzü

Cevap: vba ağdan resim çekme

İleti#15)  hemso41 » 11 May 2018 11:28

Numune Takip.rar

ektedir.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: vba ağdan resim çekme

İleti#16)  cglrkltfn » 11 May 2018 11:59

Merhabalar

Maalesef aynı hatayı vermekte. Ekte ekran görüntüsünü iletiyorum.
TEşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
cglrkltfn
Yeni Başlamış
 
Kayıt: 20 Nis 2016 09:39
Meslek: İş Geliştirme
Yaş: 30
İleti: 24
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İStanbul / Beylikdüzü

Cevap: vba ağdan resim çekme

İleti#17)  hemso41 » 11 May 2018 16:58

Ben de sorunsuz çalışıyor hatta dosyanızda eklediğim kayıtta mevcut...
Kod: Tümünü seç
on error resume next
satırını ekleyiniz(Not:Sadece uzantısı jpg olanları ekleyebilirsiniz...)
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka

Cevap: vba ağdan resim çekme

İleti#18)  cglrkltfn » 12 May 2018 10:39

Merhaba

REsim ekle butonu çalıştı. Fakat resimler olması gerektiğinden çok daha büyük görünüyor userformda, ayrıca kaydet butonuna bastığımında yine maalesef hata veriyor. Dosyayı ekte gönderiyorum.

Yardımlarınızı rica ediyorum.

Teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
cglrkltfn
Yeni Başlamış
 
Kayıt: 20 Nis 2016 09:39
Meslek: İş Geliştirme
Yaş: 30
İleti: 24
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İStanbul / Beylikdüzü

Cevap: vba ağdan resim çekme

İleti#19)  hemso41 » 14 May 2018 16:18

bakınız yolladığım dosya hatasız tam çalışıyor
ekran görüntüsü
resim11.jpg
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hemso41
Siteye Alışmış
 
Kayıt: 22 Eyl 2015 10:04
Meslek: BİLGİ İŞLEM
Yaş: 38
İleti: 336
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: izmir/karşıyaka


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 4 misafir

Bumerang - Yazarkafe