Tek satır veya çoklu satır ihtimali de eklendi.
Kod:
Sub Doldur2()
Dim OriginalRange As Range, var As Integer, sor As Integer
Dim l As Integer, m As Integer, n As Integer, O As Integer
Dim p As Integer, kelime As Variant
If Selection.Information(wdWithInTable) = True Then
Set OriginalRange = Selection.Range
sor = MsgBox(" Çoklu Satır Girişi mi Yapılacak?", vbYesNo + vbInformation, " Uyarı")
kelime = UCase(Trim(InputBox(vbLf & "Kelimeyi giriniz", "VERİ GİRİŞİ")))
If kelime = "" Then
Exit Sub
End If
m = Len(kelime)
O = Selection.Cells(1).ColumnIndex
If sor = vbYes Then
n = ((Selection.Tables(1).Columns.Count * _
Selection.Tables(1).Rows.Count) - _
((Selection.Cells(1).RowIndex - 1) * _
Selection.Tables(1).Columns.Count)) - O + 1
Else
n = (Selection.Tables(1).Columns.Count - Selection.Information(wdStartOfRangeColumnNumber)) + 1
If n < m Then
MsgBox "Bulunduğunuz hücreden itibaren " & n & " adet kutu var." & vbLf _
& "Girmek istediğiniz " & kelime & " değeri " & m & " karakter uzunluğundadır!"
Exit Sub
End If
End If
If n >= m Then
For l = 1 To n
If Len(Trim(Selection.Cells(1).Range.Text)) > 2 Then
var = var + 1
If l >= m Then Exit For
Selection.MoveRight Unit:=wdCell
Else
If l >= m Then Exit For
Selection.MoveRight Unit:=wdCell
End If
Next l
OriginalRange.Select
If var > 0 And n >= m Then
p = MsgBox("Kutularda değer var! Silinsin mi?", vbYesNo + vbInformation, " Uyarı")
If p = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
Exit Sub
Else
For l = 1 To m
Selection.Cells(1).Range.Text = ""
If l = m Then Exit For
Selection.MoveRight Unit:=wdCell
Next l
OriginalRange.Select
For l = 1 To m
Selection.Cells(1).Range.Text = Mid(kelime, l, 1)
If l = m Then Exit For
Selection.MoveRight Unit:=wdCell
Next l
End If
ElseIf var = 0 And n >= m Then
For l = 1 To m
Selection.Cells(1).Range.Text = Mid(kelime, l, 1)
If l = m Then Exit Sub
Selection.MoveRight Unit:=wdCell
Next l
End If
Else
MsgBox "Bulunduğunuz hücreden itibaren " & n & " adet kutu var." & vbLf _
& "Girmek istediğiniz " & kelime & " değeri " & m & " karakter uzunluğundadır!"
End If
Else
MsgBox "Tablo üzerinde değilsiniz, tablodan bir kutu seçiniz.", vbCritical
End If
End Sub