Word de rakamı yazıya çevirme hk.

[tamer42]

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,

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

 

[Korhan Ayhan]

İnceleyiniz.

Word'de rakamı yazıya çevirme

Selam Arkadaşlar Forumda arama yaptım ama bulamadım wordde rakkamı yazıya çevirebiliyormuyuz. Teşekkürler.

www.excel.web.tr

 

[necati]

Merhaba,

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]

Korhan & Necdet Hocam teşekkürler

 

[Korhan Ayhan]

İsimler karışmış..

 

[tamer42]

Özür; Necati Hocam

 

[necati]

Rica ederim, önemli değil.