Yayınladığım tüm makaleler

ASCII binary karakter tablosu yapımı

Tabloda satır silme ve satır ekleme işlemleri (ASCII, BINARY karakter tablosu)

Bu makalemizde sizlerle birlikte bir ASCII kod donüştürücü ve ASCII binary karakter tablosu yapmaya çalışacağız. Bu örneği yaparken birlikte bir tabloya VBA ile nasıl satır eklenir ya da bir tablodaki satırlar nasıl silinir bu da öğrenmiş olacağız. Şimdi isterseniz fazla lafı uzatmadan bunu nasıl yapacağımızı anlatmaya başlayalım.

  1. Öncelikle yeni bir belge açıyor ve makro güvenlik düzeyini düşük olarak ayarlıyoruz.  Nasıl yapılacağını hatırlamak için her zaman olduğu gibi bu bağlantıyı kullanabilirsiniz.
  2. Sonrasında aşağıda verilen ekran tasarımını yapıyor ve burada belirtilen nesnelerin name ve Caption özelliklerini ayarlıyorsunuz. Bu defaki çalışmamızda belgemize bir adet TextBox yani metin kutusu  ve diğer işlemler için de 3 adet CommandButton nesnesi eklemeniz gerekiyor. Bu arada ekran çıktısında metin kutusunun adı yazmıyor resmi hazırlarken dikkatimden kaçmış ama siz yine de unutmayın nesnenin name özelliği txtKarakter olacak.
  1. Son olarak da aşağıda verilen kodları Alt+F11 ile görütülenen VBA kod düzenleyicisi ekranında yazıyorsunuz. Her zaman olduğu gibi belgemizi kaydedip, kapatıp sonra yeniden açıyor ve yaptıklarımızı denetliyoruz. Sistem çok basit çalışıyor aslında ASCII kodunu öğrenmek istediğiniz karakteri metin kutusuna tuşluyor sonrasında Dönüştür  tuşuna basıyorsunuz. O da size hem karakterin ASCII kodunu hemde bunun 1,0 şeklinde kodlanmış halini veriyor.

Kaynak Kodlar :


'Tanimlanmayan degiskenelerin kullanimina izin verme
Option Explicit
Private Sub btnCikis_Click()
'1. Acik belgeyi kaydetmeden cik
    Application.Quit wdDoNotSaveChanges
'2. Acik belgeyi kaydet ve  cik
'    Application.Quit wdSaveChanges
End Sub
Private Function asciiToBinary(deger As Integer) As String
Dim sonuc As String, sayici As Integer
 sonuc = ""
    If deger >= 2 Then
        Do
            If deger Mod 2 = 0 Then
                deger = deger / 2
                sonuc = Trim("0") & sonuc
            Else
                deger = (deger - 1) / 2
                sonuc = Trim("1") & sonuc
            End If
        Loop Until deger <= 1
        sonuc = Trim(Str(deger)) & sonuc
    Else
       sonuc = Str(deger)
    End If
    '8 bite tamamliyoruz
    If Len(sonuc) < 8 Then
        For sayici = 1 To 8 - Len(sonuc)
            sonuc = Trim("0") & sonuc
        Next
    End If
asciiToBinary = sonuc
End Function


Private Sub btnDonustur_Click()
Dim sayac As Integer
With ThisDocument
    If .Tables.Count = 1 Then
        .Tables(1).Cell(2, 2).Range.Text = Asc(txtKarakter.Text)
        .Tables(1).Cell(2, 3).Range.Text = asciiToBinary(Asc(txtKarakter.Text))
    Else
            .Paragraphs(.Paragraphs.Count).Range.Font.ColorIndex = wdBlue
            .Paragraphs(.Paragraphs.Count).Range.Text = _
            "Dosyanın orjinal tasarimi hasar görmüş durumda..."
    End If
End With
End Sub

Private Sub btnListele_Click()
Dim sayac, sayici, deger As Integer, sonuc As String
'btnListele.Locked = True
With ThisDocument
    'sayet tablo var ise
    If .Tables.Count = 1 Then
'    'satirlar tek tek siliniyor.
'    Do Until Tables(1).Rows.Count < 4
'        Tables(1).Rows(.Tables(1).Rows.Count).Delete
'        DoEvents
'    Loop
'4. satirdan son satira kadar aralıktaki tüm satirlar
'bir defada siliniyor.
If Tables(1).Rows.Count > 3 Then
.Range(.Tables(1).Rows(4).Range.Start, .Tables(1).Rows(Tables(1).Rows.Count).Range.End).Rows.Delete
End If

        For sayac = 1 To 255
        Tables(1).Rows.Add
        .Tables(1).Cell(Tables(1).Rows.Count, 1).Range.Text = Chr(sayac)
        .Tables(1).Cell(Tables(1).Rows.Count, 2).Range.Text = Str(sayac)
        sonuc = "": deger = sayac
        If deger >= 2 Then
            Do
                If deger Mod 2 = 0 Then
                    deger = deger / 2
                    sonuc = Trim("0") & sonuc
                Else
                    deger = (deger - 1) / 2
                    sonuc = Trim("1") & sonuc
                End If
            Loop Until deger <= 1
            sonuc = Trim(Str(deger)) & sonuc
        Else
           sonuc = Str(deger)
        End If
        '8 bite tamamliyoruz
        If Len(sonuc) < 8 Then
            For sayici = 1 To 8 - Len(sonuc)
                sonuc = Trim("0") & sonuc
            Next
        End If
        '*********************************************************************************
        .Tables(1).Cell(Tables(1).Rows.Count, 3).Range.Text = sonuc
        Next
    Else
            .Paragraphs(.Paragraphs.Count).Range.Font.ColorIndex = wdBlue
            .Paragraphs(.Paragraphs.Count).Range.Text = _
            "Dosyanın orjinal tasarimi hasar görmüş durumda..."
    End If
End With
End Sub

Private Sub Document_Open()
With ThisDocument
    If .Paragraphs.Count > 15 Then
        .Paragraphs(.Paragraphs.Count).Range.Font.ColorIndex = wdRed
        .Paragraphs(.Paragraphs.Count).Range.Text = _
        "Lütfen dönüşüm yapmak istediğiniz karakteri yukarıda verilen kutuya giriniz..."
    End If
End With
End Sub

Yardımcı olması dileğiyle