autofit alignment for the word inside label on userform to equal distance up & down

[MKLAQ]

hello experts

I search for code in v module to autofit alignement for the word inside lable on userfrom to equel distance up & down .

I also posted in this forum unequal distance of the alignment between the top and bottom for labels on userform

I got some suggestions from guys, but I search for code to make it automatically when run the userform, then should autofit the words into the lable instead of I do manually especially if I have many lables .
I don't want to change high & width the lable or autosize.

I belielve to be possible by vba but this needs for extremely experts like @Jaafar Tribak & Dan_w or the others .
thanks

 

[MKLAQ]

seem there is no way by code?

 

[Jaafar Tribak]

Did you find a solution to this ?

 

[MKLAQ]

not yet

 

[Jaafar Tribak]

CenterLabelText.xlsm

Here is the code that automates everything.

In the UserForm Module:

Option Explicit

Private Type uPicDesc
    Size As Long
    Type As Long
    #If Win64 Then
        hPic As LongLong
        hPal As LongLong
    #Else
        hPic As Long
        hPal As Long
    #End If
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
    Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As uPicDesc, RefIID As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If


Private Sub CheckBox1_Change()
    Dim oCtrl As MSForms.Control
   
    For Each oCtrl In Me.Controls
        If TypeOf oCtrl Is MSForms.Label Then
            Call CenterLabelText(oCtrl, CheckBox1.Value)
        End If
    Next oCtrl
End Sub


Private Sub CenterLabelText(ByVal Label As MSForms.Label, Optional bCenter As Boolean = True)
    Const IMAGE_BITMAP = 0
    Const PICTYPE_BITMAP = 1
    Const S_OK = &H0&
    Dim IID_IDispatch As GUID, uPicInfo As uPicDesc
    Dim stdPic As StdPicture, lRet As Long
   
    If Len(Label.Caption) = 0 Then _
        Err.Raise Number:=vbObjectError + 513, _
        Description:=Label.Name & " has no Caption."
    If bCenter Then
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        With uPicInfo
            .Size = Len(uPicInfo)
            .Type = PICTYPE_BITMAP
            .hPic = 0
            .hPal = 0
        End With
        lRet = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, stdPic)
        If lRet = S_OK Then
            Label.PicturePosition = fmPicturePositionCenter
            Label.Picture = stdPic
        End If
    Else
        Label.Picture = Nothing
    End If
End Sub

 

[Jaafar Tribak]

Actually, after a second look at the abovve code, I found a much simpler and shorter way without the need of api calls.

So please, ignore the previous code and use the following one.

In the UserForm Module:

Option Explicit

Private Sub CheckBox1_Change()
    Dim oCtrl As MSForms.Control
    
    For Each oCtrl In Me.Controls
        If TypeOf oCtrl Is MSForms.Label Then
            Call CenterLabelText(oCtrl, CheckBox1.Value)
        End If
    Next oCtrl
End Sub

Private Sub CenterLabelText(ByVal Label As MSForms.Label, Optional bCenter As Boolean = True)
    
    If Len(Label.Caption) = 0 Then _
        Err.Raise Number:=vbObjectError + 513, _
        Description:=Label.Name & " has no Caption."
        
        Label.Picture = IIf(bCenter, New stdole.StdPicture, Nothing)
End Sub

 

[MKLAQ]

wow Jaafar ! this is very great . actually I lost the hope to somebody answer me , but you did it

many thanks for following my thread .

 

[Dan_W]

Wow.