گسترش چندین ستون متناسب با

Question

کیث دارای یک کاربرگ است که از ستون های A تا H استفاده می کند. او مایل است بتواند هر ستون را به میزان متناسبی بزرگ کند. به عنوان مثال، اگر او هر 8 ستون را انتخاب کند، بسیار خوب خواهد بود که بتواند لبه سمت راست ستون H را بگیرد و همانطور که به سمت راست می کشد، همه ستون ها به طور متناسب با هم فاصله داشته باشند. او فکر می کند که آیا راهی برای انجام این نوع عریض کردن ستون وجود دارد؟

برای درک بهتر آنچه کیت در مورد آن صحبت می کند، شاید یک مثال مناسب باشد. روش عادی تنظیم عرض ستون با استفاده از ماوس این است که ستون ها را انتخاب کنید و سپس یک تقسیم کننده بین سرصفحه های ستون به سمت راست یا چپ بکشید. فرض کنید که عرض ستون 5، ستون B 10، و ستون C 15 است. اگر A:C را انتخاب کنید و تقسیم کننده در سمت راست سربرگ ستون C را به 20 بکشید، این افزایش 33٪ برای ستون C. در حالت ایده آل، هر دو ستون A و B نیز 33 درصد تغییر اندازه می دهند (همانطور که کیت می خواهد)، اما در عوض، هر دو با عرض 20 تنظیم می شوند تا با ستون C مطابقت داشته باشند.

بعلاوه، نگه داشتن یک کلید اصلاح کننده (Ctrl، Alt یا Shift) در حین کشیدن ماوس هیچ تاثیری ندارد. عرض ستون ها هنوز همگی برابر با یکدیگر هستند. اگر سعی کنید راست کلیک کنید و بکشید، هیچ کاری به جز نمایش منوی زمینه انجام نمی دهد. بنابراین، از تمام آزمایش هایی که توانسته ایم انجام دهیم، هیچ راهی برای تنظیم متناسب عرض ستون ها در اکسل وجود ندارد که بتوانیم کشف کنیم.

شاید ساده ترین راه استفاده از ماکرو برای تنظیم عرض ستون باشد. موارد زیر نمونه خوبی از چنین رویکردی است.

Sub ProportionalWidth()
    Dim C As Range
    Dim sRaw As String
    Dim sTemp As String
    Dim P As Single

    sRaw = InputBox("Increase width by how what % (0 to 100)?")
    P = Val(sRaw)
    If P >= 0 And P <= 100 Then
        P = 1 + (P / 100)
        sTemp = ""
        For Each C In Selection.Columns
            sTemp = sTemp & "Column " & ColumnLetter(C.Column)
            sTemp = sTemp & ": " & C.ColumnWidth & " ==> "
            C.ColumnWidth = C.ColumnWidth * P
            sTemp = sTemp & C.ColumnWidth & vbCrLf
        Next C
        MsgBox sTemp
    Else
        MsgBox "Out of range; no adjustment made"
    End If
End Sub

Function ColumnLetter(Col As Long) As String
    Dim Arr
    Arr = Split(Cells(1, Col).Address(True, False), "$")
    ColumnLetter = Arr(0)
End Function

در واقع دو ماکرو در این مثال وجود دارد. اولین (ProportionalWidth) عرض هر ستونی را که انتخاب کرده اید تغییر می دهد. دومی (ColumnLetter) برای تبدیل شماره ستون عددی به حروف ستون استفاده می شود. این فقط در کنار هم قرار دادن گزارش (در sTemp) عرض قبل و بعد از ستون ها استفاده می شود.

وقتی ستون ها را انتخاب می کنید و ماکرو را اجرا می کنید، از شما می گوید که چقدر می خواهید آن ستون ها را گسترده تر کنید. عددی بین 0 تا 100 وارد کنید، روی OK کلیک کنید و ستون ها با این درصد باز می شوند. علاوه بر این، یک کادر پیام را مشاهده می کنید که عرض اصلی هر ستون و عرض تنظیم شده را نشان می دهد.

توجه داشته باشید که این ماکرو فقط ستون ها را بزرگ می کند. اگر می خواهید از آن برای باریک تر کردن ستون ها نیز استفاده کنید، باید آن را تغییر دهید تا شاید مقادیر منفی را مدیریت کند.