تغییر فونت در چندین کتاب کار در اکسل

Question

همیش با یک کار دلهره آور روبروست: او باید فونت های پیش فرض استفاده شده در تعداد زیادی کتاب کار اکسل را تغییر دهد. او بیش از 100 کتاب کار دارد، و فونت‌های استفاده شده در آن کتاب‌های کار باید به فونت جدیدی که طبق دستور شرکت مشخص شده است، تغییر یابد. (شما می دانید که وظایف شرکتی چگونه می تواند باشد!)

راه دستی برای نزدیک شدن به این کار این است که هر کتاب کار را بارگیری کنید، هر کاربرگ را مرور کنید، سلول‌ها را انتخاب کنید و فونت‌های آن سلول‌ها را تغییر دهید. برای پیچیده‌تر کردن کار Hamishs، او باید چندین فونت را در هر کتاب کار تغییر دهد. به عبارت دیگر، با توجه به فونت های A، B، C و D، Hamish باید فونت A را به C و فونت B را به D تغییر دهد.

بهترین راه برای حل این مشکل استفاده از یک ماکرو است. آنقدر بارگذاری، جستجو و تغییر وجود دارد که ضروری است که صرفاً واگذار کردن کار به یک کلان منطقی است. ماکرو زیر باید این کار را انجام دهد:

Sub ChangeFontNames()
    Dim vNamesFind
    Dim vNamesReplace
    Dim sFileName As String
    Dim Wkb As Workbook
    Dim Wks As Worksheet
    Dim rCell As Range
    Dim x As Integer
    Dim iFonts As Integer
    Dim sPath As String

    Change these lines as appropriate
    These are the fontnames to find
    vNamesFind = Array("Arial", "Allegro BT")
    These are the fontnames to replace
    vNamesReplace = Array("Wingdings", "Times New Roman")
    This is the folder to look for xls files
    sPath = "C:foldername"

    Application.ScreenUpdating = False
    iFonts = UBound(vNamesFind)
    If iFonts <> UBound(vNamesReplace) Then
        MsgBox "Find and Replace Arrays must be the same size"
        Exit Sub
    End If
    sFileName = Dir(sPath & "*.xls")
    Do While sFileName <> ""
        Set Wkb = Workbooks.Open(sPath & sFileName)
        For Each Wks In Wkb.Worksheets
            For Each rCell In Wks.UsedRange
                For x = 0 To iFonts
                    With rCell.Font
                        If .Name = vNamesFind(x) Then _
                            .Name = vNamesReplace(x)
                    End With
                Next
            Next
        Next
        Wkb.Close(True)
        sFileName = Dir
    Loop
    Application.ScreenUpdating = True
    Set rCell = Nothing
    Set Wks = Nothing
    Set Wkb = Nothing
End Sub

برای استفاده از ماکرو با کتاب های کاری خود، چند کار وجود دارد که باید انجام دهید. ابتدا مطمئن شوید که همه کتاب‌هایی که می‌خواهید تغییر دهید در یک پوشه ذخیره می‌شوند و نام پوشه را می‌دانید. سپس در داخل ماکرو، متغیرهای تعریف شده در نزدیکی ابتدای ماکرو را تغییر دهید. عناصر آرایه‌های vNamesFind و vNamesReplace را تغییر دهید تا با نام فونت‌هایی که می‌خواهید پیدا کنید و جایگزین کنید، مطابقت داشته باشد. سپس باید متغیر sPath را تغییر دهید تا مسیر کامل پوشه حاوی کتاب های کاری شما را در بر داشته باشد. (یک اسلش متعاقب در مسیر را فراموش نکنید.)

هنگامی که ماکرو را اجرا می کنید، هر کتاب کار را به نوبه خود در پوشه بارگیری می کند. سپس، هر کاربرگ را در هر کتاب کار مرور می‌کند و هر سلول را بررسی می‌کند. اگر سلول یکی از فونت‌هایی را داشته باشد که باید پیدا شود، با فونت جایگزین مربوطه جایگزین می‌شود. هنگامی که ماکرو با کتاب کار تمام شد، ذخیره می شود و کتاب کار بعدی پردازش می شود.

کسانی که علاقه مند به اجتناب از این نوع مشکلات در کاربرگ های جدید هستند، باید نحوه استفاده از استایل ها در اکسل را بررسی کنند. شما می توانید هر تعداد سبک را تعریف کنید و از آنها در یک کتاب کار استفاده کنید. اگر بعداً نیاز به تغییر قالب بندی برای سلول های خاص داشتید، تنها کاری که باید انجام دهید این است که سبک های اساسی را تغییر دهید. (سبک ها در شماره های دیگر ExcelTips پوشش داده شده اند . )