• DİKKAT

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

Makro ile farkı bir klasörden Jpeg dosya açmak

Katılım
27 Temmuz 2007
Mesajlar
113
Excel Vers. ve Dili
ofis 2000
Sayın üstadlarım, Excel sayfasında 150 e yakın malzeme isimleri ve L sütununda da foto kodları var. Foto kodları, c:\belgelerim\resimlerim kolasörünün altında ki resimler il eşleşmektedir. Yapamak istediğim excel sayfasında L sütununda ki herhangi bir foro koduna tıkadığım zaman c:\belgelerim\resimlerim altında ki resmin jpeg olarak açılması. Teşekkür ederim
 

Ekli dosyalar

bunu denermisiniz.

Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Sub dosyayı_aç()
AD = "c:\belgelerim\resimlerim" & "\" & n = Sheets("Sayım").Cells(ActiveWindow.Selection.Row, "L").Value
On Error Resume Next
If Dir(AD) = "" Then MkDir AD
WinExec "Explorer.exe " & AD, 1
End Sub
 
bunu sanırım worksheet change durumunda çalıştırarak kullanmalı değil mi sayın halit hocam..

Ellerinize sağlık..
 
Halit hocam maalesef çalıştıramadım.sanırım bir yerde yanlış yapıyorum.
 
Alternatif.:cool:
Sayfanıza bir atne image1 adlı image nesnesi ekledim.
Dosyanız Linktedir.:cool:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim belegelerim As String, resim As String
If Intersect(Target, Range("L2:L" & Cells(65536, "L").End(xlUp).Row)) Is Nothing Then Exit Sub
Image1.Left = Target.Offset(0, 1).Left
Image1.Top = Target.Top
If Target.Value = "" Then Exit Sub
On Error Resume Next
Image1.Picture = LoadPicture("")
belgelerim = CreateObject("wscript.shell").SpecialFolders(16)
resim = belgelerim & "\Resimlerim\" & Target.Value & ".jpg"
Image1.Picture = LoadPicture(resim)
End Sub

DOSYAYI İNDİRMEK İÇİN TIKLAYIN
 
hocam burada hata veriyor: " Image1.Left = Target.Offset(0, 1).Left"
 
hocam burada hata veriyor: " Image1.Left = Target.Offset(0, 1).Left"
Benim yolladığım dosyadamı denediniz.
Vermemesi lazım.
Eğer siz başka bir dosyaya uygulamak istediyseniz.
İmage nesnenizin adını Image1 olarak değiştiriniz.
Veya kodlarda image1 yazan yere kendi image nesneninizn adını yazınız.Bunun dışında hata vermez.:cool:Birde birleştirilmiş hücre varsa verebilir.Tıkladığınız hücrede.:cool:
Ama benim son yolladığım dosyayı tekrar kopyalayın .Hata önleyici kod yazdım onda.:cool:
 
Image1.Picture = LoadPicture(['FORM'!h30]) ile h30 hücresine resim getiriyorum. H30 hücresine resim yolu c:\foto\1.jpg şeklinde otomatik geliyor. başka hücreye değer girdiğimde c:\foto\2.jpg c:\foto\3.jpg gibi otomatik değişiyor h30 hücresi.

h30 hücresi c:\foto\4.jpg olduğunda , c:\foto\ dizininde 4.jpg resimi olmadığı zaman runtime error 53 hatası veriyor. resim bulamadığında bu hatayı önlemek için bulamadığı resim yerine dizine hata.jpg diye bir resim koysak o resmin otomatik gelmesini nasıl sağlayabiliriz.
 
Image1.Picture = LoadPicture(['FORM'!h30]) ile h30 hücresine resim getiriyorum. H30 hücresine resim yolu c:\foto\1.jpg şeklinde otomatik geliyor. başka hücreye değer girdiğimde c:\foto\2.jpg c:\foto\3.jpg gibi otomatik değişiyor h30 hücresi.

h30 hücresi c:\foto\4.jpg olduğunda , c:\foto\ dizininde 4.jpg resimi olmadığı zaman runtime error 53 hatası veriyor. resim bulamadığında bu hatayı önlemek için bulamadığı resim yerine dizine hata.jpg diye bir resim koysak o resmin otomatik gelmesini nasıl sağlayabiliriz.

:cool:
Kod:
on error resume next
Image1.Picture = LoadPicture(['FORM'!h30])
if err then Image1.Picture = LoadPicture("C:\foto\hata.jpg")
on error goto 0
 
:cool:
Kod:
on error resume next
Image1.Picture = LoadPicture(['FORM'!h30])
if err then Image1.Picture = LoadPicture("C:\foto\hata.jpg")
on error goto 0

Private Sub Worksheet_Change(ByVal Target As Range)
Image1.Picture = LoadPicture(['FORM'!h30])
Image2.Picture = LoadPicture(['FORM'!b30])
Image3.Picture = LoadPicture(['FORM'!b45])
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image2.PictureSizeMode = fmPictureSizeModeStretch
Image3.PictureSizeMode = fmPictureSizeModeStretch

kodlar bu her 3 image için sizin verdiğiniz kodları nasıl düzenlemeliyim?
 
Private Sub Worksheet_Change(ByVal Target As Range)
Image1.Picture = LoadPicture(['FORM'!h30])
Image2.Picture = LoadPicture(['FORM'!b30])
Image3.Picture = LoadPicture(['FORM'!b45])
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image2.PictureSizeMode = fmPictureSizeModeStretch
Image3.PictureSizeMode = fmPictureSizeModeStretch

kodlar bu her 3 image için sizin verdiğiniz kodları nasıl düzenlemeliyim?
:cool:

Kod:
on error resume next
Image1.Picture = LoadPicture(['FORM'!h30])
if err then Image1.Picture = LoadPicture("C:\foto\hata.jpg")
Image2.Picture = LoadPicture(['FORM'!b30])
if err then Image2.Picture = LoadPicture("C:\foto\hata.jpg")
Image3.Picture = LoadPicture(['FORM'!b45])
if err then Image3.Picture = LoadPicture("C:\foto\hata.jpg")
on error goto 0
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image2.PictureSizeMode = fmPictureSizeModeStretch
Image3.PictureSizeMode = fmPictureSizeModeStretch
 
Geri
Üst