Optik Form Oluşturma

[empati52]

Uzaktan deneme sınavı için optik form örnekteki gibidir. Öğrencilerin örnektekine benzer excelde hazırlanmış optik form üzerinde tıklayarak işaretleme yapıp göndermelerini istiyorum. Yardımlarınız için şimdiden teşekkürler.

İndir 111

Dosyayı indir 111

dosya.co

 

[Asri]

Merhaba,

Ekli dosyayı kullanabilirsiniz.
Seçimler çift tıklama ile yapılır.
Seçim iptali için aynı hücre çift tıklanmalı.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Interior.Color = vbBlack Then
        Target.Interior.Color = vbWhite
        Target.Font.Color = vbBlack
        Cells(Target.Row + 1, Target.Column).Select
        Exit Sub
   End If
 
   If Intersect(Target, Range("G3:K27")) Is Nothing Then GoTo devam1
     Range(Cells(Target.Row, "G"), Cells(Target.Row, "K")).Interior.Color = vbWhite
     Range(Cells(Target.Row, "G"), Cells(Target.Row, "K")).Font.Color = vbBlack
   
     Target.Interior.Color = vbBlack
     Target.Font.Color = vbWhite
     Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam1:
   If Intersect(Target, Range("M3:Q27")) Is Nothing Then GoTo devam2
     Range(Cells(Target.Row, "M"), Cells(Target.Row, "Q")).Interior.Color = vbWhite
     Range(Cells(Target.Row, "M"), Cells(Target.Row, "Q")).Font.Color = vbBlack
   
     Target.Interior.Color = vbBlack
     Target.Font.Color = vbWhite
     Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam2:
   If Intersect(Target, Range("S3:W27")) Is Nothing Then GoTo devam3
   
      Range(Cells(Target.Row, "S"), Cells(Target.Row, "W")).Interior.Color = vbWhite
      Range(Cells(Target.Row, "S"), Cells(Target.Row, "W")).Font.Color = vbBlack
   
      Target.Interior.Color = vbBlack
      Target.Font.Color = vbWhite
      Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam3:
   If Intersect(Target, Range("Y3:AC27")) Is Nothing Then GoTo devam4
      Range(Cells(Target.Row, "Y"), Cells(Target.Row, "AC")).Interior.Color = vbWhite
      Range(Cells(Target.Row, "Y"), Cells(Target.Row, "AC")).Font.Color = vbBlack
   
      Target.Interior.Color = vbBlack
      Target.Font.Color = vbWhite
      Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam4:
    If Intersect(Target, Range("A3:E12")) Is Nothing Then GoTo devam5
      Range(Cells(3, Target.Column), Cells(12, Target.Column)).Interior.Color = vbWhite
      Range(Cells(3, Target.Column), Cells(12, Target.Column)).Font.Color = vbBlack
   
      Target.Interior.Color = vbBlack
      Target.Font.Color = vbWhite
      Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam5:
   If Intersect(Target, Range("A14:D14")) Is Nothing Then GoTo devam6
      Range(Cells(Target.Row, "A"), Cells(Target.Row, "D")).Interior.Color = vbWhite
      Range(Cells(Target.Row, "A"), Cells(Target.Row, "D")).Font.Color = vbBlack
   
      Target.Interior.Color = vbBlack
      Target.Font.Color = vbWhite
      Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam6:
   If Intersect(Target, Range("E28:E28")) Is Nothing Then GoTo devam7
      Range(Cells(Target.Row, "E"), Cells(Target.Row, "E")).Interior.Color = vbWhite
      Range(Cells(Target.Row, "E"), Cells(Target.Row, "E")).Font.Color = vbBlack
   
      Target.Interior.Color = vbBlack
      Target.Font.Color = vbWhite
      Cells(Target.Row + 1, Target.Column).Select
 
   Exit Sub
devam7:

End Sub

 

[empati52]

Üyelik yapıyorum dostum.Teşekkür ediyorum.Forumda 2 sefer yardıma ihtiyacım oldu, anında ilgilenildi.

 

[empati52]

Dosyayı indiremiyorum. Altın üyelik için de başvurdum ama. Dosyayı alternatif yükleme yapabilecek arkadaş var mıdır.