Mouse imlecinin bulunduğu konuma artan sırayla numara verme

[PColik]

Merhabalar,

Mousela aktif sayfada herhangi bir alana sol tık yaptığımda imlecin bulunduğu konuma sırasıyla 1-2-3 diye artarak numara vermek istiyorum ayrıca yazı boyutunu ve rengini de ayarlayabilmek istiyorum. Bu işlemi ürün sayımında kullanmam gerekiyor. Çok adetli olup gözle takip etmesi zor olan sayımlarda ürünlerin fotoğraflarını bilgisayara atıp böyle bir yönteme ihtiyaç duyuyorum. Mümkün müdür? Yardımlarınız için şimdiden teşekkürler.
Saygılarımla.

 

[Korhan Ayhan]

Hücre seçimi yapacaksanız aşağıdaki komut işinize yarayacaktır.

Sayfanızın kod bölümüne uygulayınız. 1 den 20 ye kadar sıra numarası oluşturur.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveCell = 1
    ActiveCell.Resize(20).DataSeries
End Sub

 

[PColik]

Korhan bey ilginiz için çok teşekkür ederim ancak sorum bu değildi. Benim kesinlikle hücrelerle işim olmayacak, bütün olay imlecin koordinatlarında bitiyor. Şöyle düşünebilirsiniz; telefonumla çektiğim bir resmi excel sayfasına yerleştireceğim ve üzerinde işaretleme yaparak sayım yapacağım. Her tıkladığımda bana sıralı bir şekilde 1-2-3-4-5....... diye tam olarak tıkladığım konuma işaretleme yapmasını istiyorum. Bu bir nesne yada küçük resim gibi bir şey olabilir bir label bile olabilir. Hatta bu işlem bir userform aracılığı ile bile olabilir. Yeter ki sayım yapabileyim. Yardımlarınız için şimdiden teşekkürler.

 

[Asri]

Benim için güzel bir deneyim oldu

Geliştirilebilir. Çok zamanım olmadığı için özenli bir çalışma olmadı.

WeTransfer | Send Large Files Fast

The simple, quick and secure way to send your files around the world without an account. Share your files, photos, and videos today for free.

we.tl

Koda TEMİZLE butonu eklendi. Dosyada yok.

Dim off_x, off_y As Integer

Private Sub CommandButton1_Click()
  Me.lblsayici.Caption = "0"
  For Each cont In Me.Controls
    If InStr(cont.Name, "sayici") = 1 Then
        Me.Controls.Remove cont.Name
    End If
Next cont
End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   off_x = X: off_y = Y
   Me.lblsayici.Caption = Str(Val(Me.lblsayici.Caption) + 1)
   Call CreateToolTipLabel(Me.lblsayici.Caption)
End Sub

Public Function CreateToolTipLabel(STTLText As String) As Boolean
Set objToolTipLbl = Me.Controls.Add("Forms.Label.1")
With objToolTipLbl
.Top = off_y
.left = off_x
.Object.Caption = STTLText
.Object.AutoSize = True
.Object.ForeColor = vbYellow
.Object.BackColor = vbRed
.Name = "sayici"
End With
DoEvents
End Function


Private Sub UserForm_Initialize()
Me.lblsayici.Caption = "0"
End Sub

 

[PColik]

Asri bey ilginiz ve yardımınız için gerçekten çok çok teşekkür ediyorum. Size böyle güzel bir deneyim yaşatmış olmaktan da ayrıca mutlu oldum. Kesinlikle tam istediğim gibi olmuş elinize sağlık.