Resmi olmayan ürünler için vba kodu!!!

serkan_sdl · 23 Kasım 2012

Arkadaşlar merhaba...

Excel de yapmış olduğum üretim programıma ilgili ürünlerin resimlerini çağırmak için aşağıdaki kodu kullanıyorum. Örnek olarak ="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\"19002".jpg" hücresine gelen ürünle ilgili resmi ilgili hücreye başarılı bir şekilde getiriyor.

Ancak;

Ben resmi olmayan bir ürün olduğu zaman da ilgili hücreye "resimyok.jpg" getirsin istiyorum. Aşağıda ki kodu tamamlayıp bana iletirseniz çok sevinirim.

Teşekkürler

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

Image1.PictureSizeMode = fmPictureSizeModeZoom
Image2.PictureSizeMode = fmPictureSizeModeZoom
Image3.PictureSizeMode = fmPictureSizeModeZoom
Image4.PictureSizeMode = fmPictureSizeModeZoom
Image5.PictureSizeMode = fmPictureSizeModeZoom
Image6.PictureSizeMode = fmPictureSizeModeZoom

Image1.Picture = LoadPicture(['Y_Maliyet'!O1])
Image2.Picture = LoadPicture(['Y_Maliyet'!O18])
Image3.Picture = LoadPicture(['Y_Maliyet'!O19])
Image4.Picture = LoadPicture(['Y_Maliyet'!O20])
Image5.Picture = LoadPicture(['Y_Maliyet'!O21])
Image6.Picture = LoadPicture(['Y_Maliyet'!O22])

End Sub

Levent Menteşoğlu · 23 Kasım 2012

Aşağıdaki gibi deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error goto 10

Image1.PictureSizeMode = fmPictureSizeModeZoom
Image2.PictureSizeMode = fmPictureSizeModeZoom
Image3.PictureSizeMode = fmPictureSizeModeZoom
Image4.PictureSizeMode = fmPictureSizeModeZoom
Image5.PictureSizeMode = fmPictureSizeModeZoom
Image6.PictureSizeMode = fmPictureSizeModeZoom


    Image1.Picture = LoadPicture(['Y_Maliyet'!O1])
    Image2.Picture = LoadPicture(['Y_Maliyet'!O18])
    Image3.Picture = LoadPicture(['Y_Maliyet'!O19])
    Image4.Picture = LoadPicture(['Y_Maliyet'!O20])
    Image5.Picture = LoadPicture(['Y_Maliyet'!O21])
    Image6.Picture = LoadPicture(['Y_Maliyet'!O22])

exit sub

10 yol="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg"

    Image1.Picture = LoadPicture(yol)
    Image2.Picture = LoadPicture(yol)
    Image3.Picture = LoadPicture(yol)
    Image4.Picture = LoadPicture(yol)
    Image5.Picture = LoadPicture(yol)
    Image6.Picture = LoadPicture(yol)

End Sub

serkan_sdl · 24 Kasım 2012

Teşekkür ederim, ilginize, emeğinize. Ancak bu kodu uygulayınca bütün resimleri "resimyok.jpg" olarak getirdi. Yani olan resimde olmayan resimde "resimyok.jpg" geldi.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error goto 10

bu kodda bir sıkıntı var sanki! "Yani eğer resim yoksa" gibi bir kod lazım gibi..

Levent Menteşoğlu · 26 Kasım 2012

Aşağıdaki gibi denermisiniz.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Set nesne = CreateObject("Scripting.FileSystemObject")
yol="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg"
For Each hucre In [O1,O18:O22]
c = c + 1
kontrol = nesne.FileExists(hucre)
If kontrol = True Then
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(hucre)
Else
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(yol)
End If
Next
End Sub

serkan_sdl · 28 Kasım 2012

Olmadı...

Levent bey ilginize teşekkür ederim. Ancak son verdiğiniz kodu da uyguladım hata verdi!
Tek sorun şu; Her hangi bir modelin üretim reçetesini incelerken o ürünlerde kullanılan aksesuarların resimleri geliyor. Mesala "Image2" ye ""O18" hücresinde bulunan kodda ki aksesuar resmi geliyor. Ancak başka bir ürünü sorguladığımda, ilgili ürünün "O18" hücresinde kullanılan aksesuar resmi klasörde yoksa, önceki sorgulamada o hücreye hangi resim gelmişse o resim olduğu gibi duruyor. Bu da inceleyenler açısından "hata var" imajı yaratıyor. Bizim istediğimiz, eğer resim klasöründe ilgili hücrelerde bulunan isimde bir jpeg yoksa, onun yerine "resimyok.jpeg" i getirsin.

Benim çalışan kodum aşağıda olduğu gibi.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

Image1.PictureSizeMode = fmPictureSizeModeZoom
Image2.PictureSizeMode = fmPictureSizeModeZoom
Image3.PictureSizeMode = fmPictureSizeModeZoom
Image4.PictureSizeMode = fmPictureSizeModeZoom
Image5.PictureSizeMode = fmPictureSizeModeZoom
Image6.PictureSizeMode = fmPictureSizeModeZoom
Image7.PictureSizeMode = fmPictureSizeModeZoom
Image8.PictureSizeMode = fmPictureSizeModeZoom
Image9.PictureSizeMode = fmPictureSizeModeZoom
Image10.PictureSizeMode = fmPictureSizeModeZoom
Image11.PictureSizeMode = fmPictureSizeModeZoom
Image12.PictureSizeMode = fmPictureSizeModeZoom
Image13.PictureSizeMode = fmPictureSizeModeZoom
Image14.PictureSizeMode = fmPictureSizeModeZoom
Image15.PictureSizeMode = fmPictureSizeModeZoom
Image16.PictureSizeMode = fmPictureSizeModeZoom
Image17.PictureSizeMode = fmPictureSizeModeZoom
Image18.PictureSizeMode = fmPictureSizeModeZoom
Image19.PictureSizeMode = fmPictureSizeModeZoom

Image1.Picture = LoadPicture(['Y_Maliyet'!O1])
Image2.Picture = LoadPicture(['Y_Maliyet'!O18])
Image3.Picture = LoadPicture(['Y_Maliyet'!O19])
Image4.Picture = LoadPicture(['Y_Maliyet'!O20])
Image5.Picture = LoadPicture(['Y_Maliyet'!O21])
Image6.Picture = LoadPicture(['Y_Maliyet'!O22])
Image7.Picture = LoadPicture(['Y_Maliyet'!O23])
Image8.Picture = LoadPicture(['Y_Maliyet'!O24])
Image09.Picture = LoadPicture(['Y_Maliyet'!O25])
Image10.Picture = LoadPicture(['Y_Maliyet'!O26])
Image11.Picture = LoadPicture(['Y_Maliyet'!O27])
Image12.Picture = LoadPicture(['Y_Maliyet'!O28])
Image13.Picture = LoadPicture(['Y_Maliyet'!O29])
Image14.Picture = LoadPicture(['Y_Maliyet'!O30])
Image15.Picture = LoadPicture(['Y_Maliyet'!O31])
Image16.Picture = LoadPicture(['Y_Maliyet'!O32])
Image17.Picture = LoadPicture(['Y_Maliyet'!O33])
Image18.Picture = LoadPicture(['Y_Maliyet'!O34])
Image18.Picture = LoadPicture(['Y_Maliyet'!O35])

End Sub

Levent Menteşoğlu · 28 Kasım 2012

Verdiğim kodun çalışması gerekir. Sadece aralıkları eklediğiniz koda göre genişletin. Bu arada verdiği hata nedir? Olmazsa dosyanızı ekleyin ben gerekli düzeltmeleri yapayım.

serkan_sdl · 28 Kasım 2012

Peki benim eklemeyi siz yaparmısınız? Ben yukarıda kodu tamamen yazdım. Eğer orada düzeltmeyi yaparsanız yeniden deneyeyim.

Teşekkürler...

serkan_sdl · 28 Kasım 2012

Hata...

Hata da ekte...

Compile error
Ambiguous name delected Worksheet_Change

Levent Menteşoğlu · 28 Kasım 2012

serkan_sdl' Alıntı:
Hata da ekte...

Compile error
Ambiguous name delected Worksheet_Change

Bu hata aynı isimde iki prosedür varsa ortaya çıkar. Eski worksheet_change prosedürünü silip sadece benim önerdiğimi kopyalayın.

serkan_sdl · 28 Kasım 2012

Süper oldu, çok teşekkür ederim. Emeğinize sağlık...

serkan_sdl · 28 Kasım 2012

Yanlız şöyle bir sorun ortaya çıktı;

Eğer ürün kodu yanlış yazılırsa, direk VBA hatası veriyor!

Hata içeriği de ;

Run time error "13"

Type mismatch

kontrol = nesne.FileExists(hucre) (sarıya boyanmış)

Acaba bu hata yerine "İlgili ürünün maliyet çalışması yapılmamıştır..." gibi bir mesaj verebilir mi?

Levent Menteşoğlu · 28 Kasım 2012

Aşağıdaki gibi deneyin

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Set nesne = CreateObject("Scripting.FileSystemObject")
yol="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg"
For Each hucre In [O1,O18:O22]
c = c + 1
if hucre="" then
msgbox "İlgili ürünün maliyet çalışması yapılmamıştır...",32,"Uyarı"
goto 10
end if
kontrol = nesne.FileExists(hucre)
If kontrol = True Then
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(hucre)
Else
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(yol)
End If
10 Next
End Sub

serkan_sdl · 29 Kasım 2012

Hocam teşekkür ederim ama aynı hatayı yeniden verdi. Aslında çalışmayı size göndermek istiyorum ama, boyutu çok yüksek!

Aslında sorun şu;

[O1,O18:O32] hücreleri bu formülle;

"="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\"&B18&".jpg"

"B1,B18:B32" resim değerlerini oluşturuyor! Eğer bu (B1,B18:B32) hücrelerinde

#YOK değeri varsa bu hata ortaya çıkıyor! Yani ya "End" yada "Deburg" seçimleri var. Ben bu hatanın yerinde "Aradığınız ürünün maliyet çalışması yapılmamıştır..." gibi bir mesaj versin istiyorum...

Levent Menteşoğlu · 29 Kasım 2012

Aşağıdaki gibi deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) 
Set nesne = CreateObject("Scripting.FileSystemObject") 
yol="\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg" 
For Each hucre In [O1,O18:O32] 
c = c + 1 
if hucre="" or IsError(hucre)=true then 
msgbox "İlgili ürünün maliyet çalışması yapılmamıştır...",32,"Uyarı" 
goto 10 
end if 
kontrol = nesne.FileExists(hucre) 
If kontrol = True Then 
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(hucre) 
Else 
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture= LoadPicture(yol) 
End If 
10 Next 
End Sub

serkan_sdl · 30 Kasım 2012

Hocam buda olmadı.. Ekte ki hatayı veriyor

Levent Menteşoğlu · 30 Kasım 2012

Aşağıdaki gibi deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Set nesne = CreateObject("Scripting.FileSystemObject")
yol = "[URL="file://\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg"]\\sunucu\inetpub\wwwroot\KuleliWeb\resimler\resimyok.jpg[/URL]"
For Each hucre In [O1,O18:O32]
c = c + 1
If hucre = "" Or IsError(hucre) = True Then
MsgBox "İlgili ürünün maliyet çalışması yapılmamıştır...", 32, "Uyarı"
GoTo 10
End If
kontrol = nesne.FileExists(hucre)
If kontrol = True Then
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(hucre)
Else
Sheets("Y_Maliyet").Shapes("Image" & c).OLEFormat.Object.Object.Picture = LoadPicture(yol)
End If
10 Next
End Sub

serkan_sdl · 30 Kasım 2012

Hocam yine olmadı, hata ekte...

Levent Menteşoğlu · 30 Kasım 2012

Debug butonuna basınca hangi satır renkleniyor.

serkan_sdl · 1 Aralık 2012

Hocam teşekkür ederim...

Hocam teşekkür ederim. Ben veri doğrulama yöntemiyle çözdüm bu işi.

Çok sağolun...

serkan_sdl · 1 Aralık 2012

Ama bilgi vermek açısından,

If hucre = "" Or IsError(hucre) = True Then

buraya geliyor..

Resmi olmayan ürünler için vba kodu!!!

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

Levent Menteşoğlu

Administrator

serkan_sdl

Ekli dosyalar

Levent Menteşoğlu

Administrator

serkan_sdl

Ekli dosyalar

Levent Menteşoğlu

Administrator

serkan_sdl

serkan_sdl