hücreye çift tıklayarak resim ekleme

[Crazy Drake]

e1:d8 birleşik hücresine çift tıklayınca resmi seçtiğimiz resim ekle ekranı gelecek ve seçtiğimiz resim o hücreye sığacak şekilde ayarlayacak bir kod lazım uğraştımda visual basic bilgim yetersiz kalıyor :redface: yardımcı olabilirmisiniz

 

[Crazy Drake]

resim ekle ekranını

Application.Dialogs(xlDialogInsertPicture).Show

koduyla getiriyorum ancak eklediğim resmi o hücrelere göre boyutlandıramıyorum boyutlandırma nasıl olacak

 

[öğrtm]

mrb

sayın crazy şöyle birşey deneseniz problem çözülür mü?bu kodun çalışması için belgelerimde jpg uzantılı bir resim olmalı.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim resim
x = InputBox("resim adını yaz", "resim ekle")
resim = ("C:\Documents and Settings\myy\Belgelerim\Resimlerim\" & x & ".jpg")


ActiveSheet.Pictures.Insert(resim).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = 95
Selection.ShapeRange.Height = 120
Selection.ShapeRange.IncrementLeft 95
Selection.ShapeRange.IncrementTop -50





End Sub

 

[Necdet]

Merhaba,

Birleştirilmiş hücrede ve 2003 sürümde pek başarılı değil ama aşağıdaki kodların ilgili sayfanın kod bölümünde olması gerekir.

Herhangi bir hücreye çift tıklamak yeterlidir.

Kodların alındığı adres : http://www.ozgrid.com/forum/showthread.php?t=62510

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Sheets(1).Pictures.Delete
Application.Dialogs(xlDialogInsertPicture).Show
Set p = ActiveSheet.Pictures(1)
With Range("D1")
    t = .Top
    l = .Left
    w = .Offset(0, .Columns.Count).Left - .Left
    h = .Offset(.Rows.Count, 0).Top - .Top
End With
With p
    .Top = t
    .Left = l
    .Width = w
    .Height = h
End With
    With [D1]
        Shapes(1).Left = .Left + ((.Width - Shapes(1).Width) / 2)
        Shapes(1).Top = .Top + ((.Height - Shapes(1).Height) / 2)
    End With
End Sub

 

[nenada]

selamlar öğrtm,

Bu vermiş olduğunuz kod çok işime yaradı teşekkürler. Sadece şunu beceremedim. Çift tıklayarak imzasının gelmesini istediğim birkaç kişi var ve hepsi birleştirilmiş farklı hücrelerde. Bu birleştirilmiş (Örn;J 4,5,6,7,8) hücreye her kişi için nasıl bu işi yapacağım? Şimdiden teşekkürler.

 

[turgayzeynep]

Çift tıklanan hücreye fotonun hücre boyutuna göre olması için ne lazılması lazım

 

[Asri]

Çift tıklanan hücreye fotonun hücre boyutuna göre olması için ne lazılması lazım

Hücrede resim var ise aşağıdaki şekilde yapılabilir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = Target.Address Then
            sh.LockAspectRatio = msoFalse
            sh.Left = ActiveCell.Left
            sh.Top = ActiveCell.Top
            sh.Width = ActiveCell.Width + 1
            sh.Height = ActiveCell.Height + 1
        End If
    Next
    Cancel = True
End Sub