Word de rakamı yazıya çevirme hk.

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
Merhabalar,

Aşağıdaki kod ile bir word dosyasında seçili olan değeri olduğu yerde text' e çevirmektedir, benim istediğim rakamı silmeden yanına yazması
Örnek: "568 : beşyüzaltmışsekiz" şeklinde

ekli dosyada olduğu tabloda sol sütunda yazan rakamı; sağ sütunda yazıyla yazmasını nasıl sağlayabilirm? yada bunu excelde olduğu gibi kullanıcı tanımlı fonksiyon haline getirme imkanı var mıdır?

ilginize şimdiden teşekkürler,

Kod:
Sub ConvertNumberToWord()
    Dim xDigit As Double
    Dim xBuff As String
    On Error Resume Next
    
    Selection.MoveLeft wdWord, 1, wdMove
    Selection.MoveRight wdWord, 1, wdExtend
    xDigit = Val(Trim(Selection.Text))
    
    If xDigit = 0 And Str(xDigit) <> Trim(Selection.Text) Then Exit Sub
    
    If xDigit > 999999 Then
    
        If xDigit <= 999999999 Then
            xBuff = Trim(Int(Str(xDigit / 1000000)))
            Selection.Fields.Add Selection.Range, wdFieldEmpty, "= " + xBuff + " \* CardText", True
            Selection.MoveLeft wdWord, 1, wdExtend
            xBuff = Selection.Text & " million "
            xDigit = Right(Str(xDigit), 6)
        End If
        
    End If
    
    If xDigit <= 999999 Then
    
        Selection.Fields.Add Selection.Range, wdFieldEmpty, "= " + Str(xDigit) + " \* CardText", True
        Selection.MoveLeft wdWord, 1, wdExtend
        xDigit = xBuff & Selection.Text
        Selection.TypeText xDigit + " "
    Else
    
        MsgBox "Number too large", vbOKOnly, "Convert Number To Word"
    End If
    
End Sub
 

Ekli dosyalar

Katılım
20 Şubat 2007
Mesajlar
502
Excel Vers. ve Dili
2007 Office, Tr
Merhaba,
Kod:
Sub ConvertNumberToWord()
    Dim xDigit As Double
    Dim xBuff As String
    On Error Resume Next
   
    Selection.MoveLeft wdWord, 1, wdMove
    Selection.MoveRight wdWord, 1, wdExtend
    xDigit = Val(Trim(Selection.Text))
   
    If xDigit = 0 And Str(xDigit) <> Trim(Selection.Text) Then Exit Sub
   
    If xDigit > 999999 Then
   
        If xDigit <= 999999999 Then
            xBuff = Trim(Int(Str(xDigit / 1000000)))
        Selection.MoveRight wdWord
        Selection.TypeText Text:=" : "
        'Selection.MoveRight Unit:=wdCell         'Üstteki iki satırı pasif yapıp bu satırı aktif ederseniz sağdaki sütunda yazdırır.

            Selection.Fields.Add Selection.Range, wdFieldEmpty, "= " + xBuff + " \* CardText", True
            Selection.MoveLeft wdWord, 1, wdExtend
            xBuff = Selection.Text & " million "
            xDigit = Right(Str(xDigit), 6)
        End If
       
    End If
   
    If xDigit <= 999999 Then
   
        Selection.MoveRight wdWord
        Selection.TypeText Text:=" : "
        'Selection.MoveRight Unit:=wdCell         'Üstteki iki satırı pasif yapıp bu satırı aktif ederseniz sağdaki sütunda yazdırır.

        Selection.Fields.Add Selection.Range, wdFieldEmpty, "= " + Str(xDigit) + " \* CardText", True
        Selection.MoveLeft wdWord, 1, wdExtend
        xDigit = xBuff & Selection.Text
        Selection.TypeText xDigit + " "
    Else
        MsgBox "Number too large", vbOKOnly, "Convert Number To Word"
    End If
   
End Sub
 

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
Korhan & Necdet Hocam teşekkürler
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İsimler karışmış.. ;)
 

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
2,945
Excel Vers. ve Dili
Office 2013 İngilizce
Özür; Necati Hocam
 
Katılım
20 Şubat 2007
Mesajlar
502
Excel Vers. ve Dili
2007 Office, Tr
Rica ederim, önemli değil.
 
Üst