Mesaj kutusuna gelen yazıları ortalama

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyamı açtığımda mesaj kutusu ekrana gelmektedir.

Benim yapmak istediğim ekrana gelen mesaj kutusu içerisindeki yazıların ortalayarak yazmasını istiyorum.

Yardımcı olur musunuz?
.

 

[askm]

Msgbox ın bu şekilde bir özelliği yok diye biliyorum. Size 2 çözüm sunabilirim.
1. Çözüm: msgbox yerine userform ile yazı çıkartırsınız.
2. Çözüm: Yazının uzunluğuna göre farklı msgbox hazırlarsınız. Baş kısmına space ile boşluk eklersiniz. Yani manuel ortalarsınız.

 

[ASLAN7410]

Sayın askm ilginiz için çok teşekkür ediyorum.

Vba çok geniş kodlara sahip böyle bir kod yok mu acaba?

Bilgisi olan arkadaşlar var mı?

 

[Asri]

Aşağıdaki şekilde deneyiniz.

Option Explicit
Sub test_message()
    Dim a, merhaba, kullanici
    
    merhaba = String(10, " ") & "Merhaba"
    kullanici = String(10, " ") & "Osman Hamdi Bey"

    a = myMsg(vbYes, "Bilgi", merhaba, "", kullanici, "")
    
End Sub

Function myMsg(buttons As VbMsgBoxStyle, title As String, ParamArray PromptTxt())
'
' Centre prompt on Excel message box
'
' Written by Andy Pope @ Digitab    19-March-1998
'
'
    Dim tmpText As TextBox          ' temporary object used to get true Font sizing
    Dim RealTextWidth As Single     ' size of widest string
    Dim ChopTrailers As Integer     ' start of trailing spaces
    Dim PromptBuf As String         ' new msgbox prompt
    Dim i As Integer

' Create a textbox of worksheet in order to get true length of text

    Set tmpText = Worksheets(1).TextBoxes.Add(1, 1, 1, 1)
' set properties of textbox to mimic normal messagebox appearence

    With tmpText
        .Font.Name = "MS Sans Serif"
        .Font.Size = 8.5
        .VerticalAlignment = xlTop
        .HorizontalAlignment = xlLeft
        .Orientation = xlHorizontal
        .AutoSize = True
    End With
' determine the actual longest string

    For i = LBound(PromptTxt) To UBound(PromptTxt)
        tmpText.Text = CStr(PromptTxt(i))
        If tmpText.Width > RealTextWidth Then RealTextWidth = tmpText.Width
    Next i
' pad out lines
' the period is used to fool the textbox to take trailing spaces
' Chop keeps a record of where the trailing space start

    For i = LBound(PromptTxt) To UBound(PromptTxt)
        ChopTrailers = Len(PromptTxt(i))
        tmpText.Text = CStr(PromptTxt(i)) & "."
        Do While tmpText.Width < RealTextWidth
            tmpText.Text = " " & Left(tmpText.Text, Len(tmpText.Text) - 1) & " ."
            ChopTrailers = ChopTrailers + 1
        Loop
' Build new prompt and append linefeeds

        PromptBuf = PromptBuf & Left(tmpText.Text, ChopTrailers) & Chr(10)
    Next i

' remove trailing line feed from prompt

    PromptBuf = Left(PromptBuf, Len(PromptBuf) - 1)
    'MsgBox PromptBuf
    myMsg = MsgBox(PromptBuf, buttons, title)

' remove textbox from worksheet

    tmpText.Delete

End Function

 

[ASLAN7410]

Sayın Asri Bey, ellerinize sağlık tam istediğim gibi olmuş, çok teşekkür ediyorum.

Mesaj içerisine VbInformation'u eklemeye çalışıyorum ama bir türlü yapamadım

 

[Asri]

Sayın Asri Bey, ellerinize sağlık tam istediğim gibi olmuş, çok teşekkür ediyorum.

Mesaj içerisine VbInformation'u eklemeye çalışıyorum ama bir türlü yapamadım

Aşağıdaki şekilde deneyiniz.

myMsg = MsgBox(PromptBuf, vbInformation, title)

 

[ASLAN7410]

Sayın Asri Bey, çok teşekkür ediyorum, süper oldu. Allah razı olsun.

Hayırlı çalışmalar, hayırlı geceler diliyorum.