• DİKKAT

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

Gizli resmi gösterme

Z

zahitsen

Katılım
22 Kasım 2012
Mesajlar
102
Excel Vers. ve Dili
excel 2007
türkçe
Arkadaşlar ekteki örnekte anllatım ne yapmak istediğimi şöyle kalan sütununde kalvyede ok yonleriyle satırlarda aşagı yukarı giderken açıklama da resimler gözüksün istiyorum sizce mümkün mü yardımlarınızı bekliyorum.
 
Merhaba
İyi Çalışmalar
Dosyanız Ektedir
 
Son düzenleme:
asr35' Alıntı:
Merhaba
İyi Çalışmalar
Dosyanız Ektedir
Genişletmek için tıkla ...

Teşkkürler ama şöyle bi sıkıntı var sadece ürün kodunda aşağı yukarı resim değişiyor şöyle yapazmıyız hangi koda ait satırdaysa o resim ürün kodunun yanında çıksın mesala kalan sutununda da yukarı aşağı yapınca resim değişssin o köşede o zaman süper olucak.
 
Alternatif dosya
 

Ekli dosyalar

teşekkürler arkadaşlar her şey için mükemmelsiniz.
 
halit3' Alıntı:
Alternatif dosya
Genişletmek için tıkla ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double
Columns("G").ClearComments
If Target.Value = "" Then Exit SubWith Cells(Target.Row, "G")
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, "G") & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub

1.birden çok satır seçince makro hata veriyor kırmızı olan yer gösretiyor hata oraya bi engelleyici koyamazmıyız acaba birden çok hücre seçince hata veriyor çünkü.
2. ben araya sutunlar ekeyip çıkartçam arada sırada g sununu olucak f sutunu o zaman sıkıntı olacak makroda sabitleyemezmiyiz acaba en son sutun şeklinde bir kodla veya sizin bildiğiniz bir yontem varsa
 
Son düzenleme:
zahitsen' Alıntı:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double
Columns("G").ClearComments
If Target.Value = "" Then Exit SubWith Cells(Target.Row, "G")
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, "G") & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub

1.birden çok satır seçince makro hata veriyor kırmızı olan yer gösretiyor hata oraya bi engelleyici koyamazmıyız acaba birden çok hücre seçince hata veriyor çünkü.
2. ben araya sutunlar ekeyip çıkartçam arada sırada g sununu olucak f sutunu o zaman sıkıntı olacak makroda sabitleyemezmiyiz acaba en son sutun şeklinde bir kodla veya sizin bildiğiniz bir yontem varsa
Genişletmek için tıkla ...


Bu kodu denermisiniz.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double
Columns("G").ClearComments
[COLOR="Red"]If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub[/COLOR]
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, "G")
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, "G") & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub
 
Teşekkürler bir tek problem kaldı mesale g sutununun onüne sürekli sutun ekliyeceğim ama g sütünü hep sonda olucak acaba ona bi çözüm bulabilirmisiniz.Çünkü önüne sutun eklediğimde g sutunu oluyor h sutunu sürekli değiştirmek gerekiyor.yardımlarınız için teşekkürler.
 
Kod: 
KolonSayisi = Worksheets(Sayfa Adınız).UsedRange.Columns.Count

bu formül size kullanılan kolon sayısını verir. daha sonra kodda "G" şeklinde gördüğünüz yerleri tırnaksız olarak KolonSayisi yazınız.
 
doganbaris' Alıntı:
Kod: 
KolonSayisi = Worksheets(Sayfa Adınız).UsedRange.Columns.Count

bu formül size kullanılan kolon sayısını verir. daha sonra kodda "G" şeklinde gördüğünüz yerleri tırnaksız olarak KolonSayisi yazınız.
Genişletmek için tıkla ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double, KolonSayisi As Integer
KolonSayisi = Worksheets(SİPARİŞLER).UsedRange.Columns.Count
Columns(KolanSayisi).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, KolonSayisi)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, KolanSayisi) & ".bmp"
Selection.Height = 300 'yuk
Selection.Width = 400 'gen
Target.Select

End Sub

Şu Şekilde yaptım ama hata veriyor anlamadım tam yardımınızı bekliyorum.
 
hata veriyor demek yerine verdiği hatayı belirtseniz sanırım daha kolay yardımcı olunabilir...

Kolon yerine Kolan yazdığınız yerler var, onları düzeltirseniz sanırım sorun kalmaz

bir de worksheets(SİPARİŞLER) in worksheets("SİPARİŞLER") şeklinde tırnak içinde olması gerekiyor.
 
doganbaris' Alıntı:
hata veriyor demek yerine verdiği hatayı belirtseniz sanırım daha kolay yardımcı olunabilir...

Kolon yerine Kolan yazdığınız yerler var, onları düzeltirseniz sanırım sorun kalmaz

bir de worksheets(SİPARİŞLER) in worksheets("SİPARİŞLER") şeklinde tırnak içinde olması gerekiyor.
Genişletmek için tıkla ...



Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double
KolonSayisi = Worksheets("SİPARİŞLER").UsedRange.Columns.Count
Columns(KolonSayisi).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, KolonSayisi)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, [COLOR="Red"]KolonSayisi[/COLOR]) & ".bmp"
Selection.Height = 300 'yuk
Selection.Width = 400 'gen
Target.Select

End Sub
 
Son düzenleme:
zahitsen' Alıntı:
Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double
KolonSayisi = Worksheets("SİPARİŞLER").UsedRange.Columns.Count
Columns(KolonSayisi).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, KolonSayisi)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, [COLOR="Red"]KolonSayisi[/COLOR]) & ".bmp"
Selection.Height = 300 'yuk
Selection.Width = 400 'gen
Target.Select

End Sub
maalesef bi yerde eksiklik var sutun eklerken resimlerde gidiyor bi yan sutuna ama sutun azaltğımda resimler gelmioyor aynı yerde kalıyor bi eksiklik var.
Genişletmek için tıkla ...
 
Son düzenleme:
Açıklama

Bu kod birinci satırdaki en son dolu sütun değerine göre çalışmaktadır.

kod:

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double

son = Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).End(xlToLeft).Column

Columns(son).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, son)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, son) & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub
 
halit3' Alıntı:
Açıklama

Bu kod birinci satırdaki en son dolu sütun değerine göre çalışmaktadır.

kod:

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double

son = Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).End(xlToLeft).Column

Columns(son).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, son)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, son) & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub
Genişletmek için tıkla ...

çok teşekkürler her geçen gün bi şeyler öğreniyorum sayenizde.
 
halit3' Alıntı:
Açıklama

Bu kod birinci satırdaki en son dolu sütun değerine göre çalışmaktadır.

kod:

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double

son = Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).End(xlToLeft).Column

Columns(son).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, son)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, son) & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen
Target.Select

End Sub
Genişletmek için tıkla ...

son olarak :))
mesela hücrelerde klavyeden aşağı indikçe resimler sayfanın görünmeyen aşağı kısmına doğru kaçıyor. resimleri sayfanın ortasında dursa sol tarafta hücreler aşağı gitse sürekli olabilirmi.
 
zahitsen' Alıntı:
son olarak :))
mesela hücrelerde klavyeden aşağı indikçe resimler sayfanın görünmeyen aşağı kısmına doğru kaçıyor. resimleri sayfanın ortasında dursa sol tarafta hücreler aşağı gitse sürekli olabilirmi.
Genişletmek için tıkla ...

kod:

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim yuk As Double, gen As Double

son = Worksheets(ActiveSheet.Name).Cells(1, Columns.Count).End(xlToLeft).Column

Columns(son).ClearComments
If InStr(Target.Address, ":") > 0 Or InStr(Target.Address, ",") > 0 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Cells(Target.Row, son)
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
End With
On Error Resume Next
Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "\Resimler\" & Cells(Target.Row, son) & ".jpg"
Selection.Height = 200 'yuk
Selection.Width = 300 'gen

[COLOR="Red"]If ActiveCell.Top - ActiveWindow.VisibleRange.Top + Selection.Height > ActiveWindow.VisibleRange.Height Then
Selection.Top = Selection.Top - Selection.Height
End If[/COLOR]

Target.Select

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst