Excelde Dinamik Isaretleme

Selamlar daha onceden hatirlayacaksiniz buna benzer bir konu paylasmistim, cift tiklayarak checkbox olusturma adinda bir konuydu;

konumuzda sahte widdings fontu ile olusturdugumuz check isaretleri vardi.. Simdiki konumuz bir nevi onun biraz daha komplike ve gorsel versiyonu diyebiliriz..

Dinamik_Isaretleme

Onceki konumuzu inceleyiniz: http://exceltr.com/2011/02/cift-tiklayarak-checkbox-olusturma/

Konumuza gelecek olursak, uc ayri tablomuz var gordugunuz uzere ve bu tablolarimizda 2`li 3 `lu checkboxlarimiz ile 4`lu ilerleme bar`imiz mevcut..

dinamik_isaretleme_isimler

Isim tanimalma ile o kadar cok konu anlattim ki o yuzden cok detaya girmicem anlamadiginiz bolumde sorunuz lutfen, yukaridaki isimlerimizden gordugunuz uzere 3`u tablolarimiz zaten, alfabetik_say olan alfabetik sayim yapan hucreye ait olan.. Isaretleme_araliklari ise cift tiklama yapilabilen bolumun secimini yaptiginiz bolum.. rr` ler ise kod bolumumuzde goreceksiniz;

dinamik_isaret Target, [isaretleme_araliklari], [{“rr_1″;”rr_0″;”rr_2″;”rr_3”}], Cancel, True hedeflediginiz yani cift tikladiginiz bolumun istenilen aralik icinde olup olmadigini ve degerlerinin belirlediginiz 1 den 4 e kadar olan degerler olup olmadigini kontrol eden bir kodumuz var.. Oncelikle bu bolumun kodlarini sonra ise modulun kodlarini vereyim.. Ilk etapta sayfanin cift tiklama olayina gelecek kodlarimiz..

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'sadece tekli bir islem yapicaksaniz alttaki satiri kullanabilirsiniz
'dinamik_isaret Target, [isaretleme_araliklari], [{1,0,""}], Cancel, True
' coklu ise bunu kullanmaniz gerekmekte
dinamik_isaret Target, [isaretleme_araliklari], [{"rr_1";"rr_0";"rr_2";"rr_3"}], Cancel, True
End Sub 

Simdide modulumuze ait kodlar :

 

Option Explicit
Public Sub dinamik_isaret(rTarget As Range, _
rValidRange As Range, _
vRoudmarkQue As Variant, _
Optional bCancel As Boolean, _
Optional bDisableDragandDrop As Boolean)
Dim i As Long, L As Long, U As Long
On Error Resume Next
If rTarget.Cells.Count > 1 Then Exit Sub
If Intersect(rTarget, rValidRange) Is Nothing Then Exit Sub
If GetArrayDimesions(vRoudmarkQue) = 2 Then
For i = 1 To rValidRange.Areas.Count
If Not Intersect(rTarget, rValidRange.Areas(i)) Is Nothing Then
vRoudmarkQue = Evaluate(vRoudmarkQue(i, 1))
Exit For
End If
Next
End If
L = LBound(vRoudmarkQue)
U = UBound(vRoudmarkQue)
With Application
If bDisableDragandDrop Then .CellDragAndDrop = False
.Cursor = xlNorthwestArrow
For i = L To U
If rTarget = vRoudmarkQue(i) And Len(rTarget) = Len(vRoudmarkQue(i)) Then Exit For
Next
i = i + 1
If i > U Then i = L
rTarget = vRoudmarkQue(i)
.Cursor = xlDefault
bCancel = True
End With
End Sub
Public Function GetArrayDimesions(vArray) As Long
Dim i As Long
On Error GoTo ErrorHandler
Do
i = i + 1
Loop While UBound(vArray, i)
ErrorHandler:
GetArrayDimesions = i - 1
End Function

Ayrica bir kodumuz daha var bunuda calismamizin workbook`unun kapanma ozelligine ekliyoruz..

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CellDragAndDrop = True
End Sub

Dinamik Isaretleme

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

“Excelde Dinamik Isaretleme” için 1 yorum

  1. Geri bildirim: Duruma Gore Karakter

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


5 + 9 =