امبد (Embed) کردن فونت در اکسل

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

در نرم‌افزارهای ورد و پاورپوینت این مشکل به راحتی با رفتن به تنظیمات فایل و امبد (Embed) کردن فونت‌ها قابل حل است. اما متأسفانه در اکسل چنین امکانی وجود ندارد و این مشکل راه حل ساده‌ای مانند ورد و پاورپوینت ندارد. در ادامه به یکی از راه‌های حل این مشکل در اکسل با استفاده از ماکرونویسی خواهیم پرداخت.

برای این منظور تنها کافیست مراحل زیر را انجام دهید:

1. 1. یک فایل اکسل باز کنید و نام ورکشیت را بە “fonts” تغییر دهید.
   2. در همان ورک‌شیت از تب Insert، گروه Text گزینه‌ی Object را بزنید. مانند تصویر زیر:
   3. سپس در کادر محاوره‌ای Object، در تب Create from File، بر روی Browse کلیک کنید و فونت‌های مورد نظرتان را برای درج در ورک‌شیت از کادر محاوره‌ای Browse انتخاب کنید. در نهایت بر روی Insert و سپس OK کلیک کنید.
   4. هر یک از شیء‌ها را انتخاب کرده و در جعبه نام (NameBox) نام آن‌ها را دقیقاً مشابه با نام Object نمایش‌داده‌شده تغییر دهید.
   5. کلیدهای ALT + F11 را نگه دارید تا پنجره‌ی Microsoft Visual Basic for Applications باز شود.
   6. از پنجرەی سمت چپ (Project) بر روی ThisWorkbook دابل‌کلیک کنید و کد زیر را در آن قرار دهید (تصویر فوق).

      ' force explicit variable declaration
      Option Explicit
      
      ' set default array subscripts to 1
      Option Base 1
      
      ' 32bit & 64bit dec's
      #If VBA7 And Win64 Then
          Private Declare PtrSafe Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As LongPtr
          Private Declare PtrSafe Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As LongPtr
      #Else
          Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As Long
          Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As Long
      #End If
      
      ' // copy the OLE objects out to the users "temp" Folder & install the Fonts as a resource upon opening the Workbook
      Private Sub Workbook_Open()
      
          ' // vars
          Dim objFont As OLEObject
          Dim objFilename As String
          Dim objShell As Object
          Set objShell = CreateObject("shell.application")
          Dim objFolder As Variant
          Set objFolder = objShell.Namespace(Environ("Temp") & Application.PathSeparator)
          Dim objFolderItem As Variant
          Set objFolderItem = objFolder.Self
      
          ' // copy out the OLE objects from the "fonts" Worksheet into a temp Folder
          For Each objFont In Worksheets("fonts").OLEObjects
              ' // get the Filename of each Font Object
              '    Please note: you must set this yourself when you add embed the Fonts
              objFilename = objFont.Name
              ' // Copy the Font to the Clipboard
              objFont.Copy
              ' // Paste the Font from the Clipboard to the "temp" Folder
              If Dir(CStr(Environ("Temp") & Application.PathSeparator & objFilename), vbDirectory) = vbNullString Then
               objFolderItem.InvokeVerb ("Paste")
              End If
              ' // add each Font as a resource in Excel
              AddFontResource Environ("Temp") & Application.PathSeparator & objFilename
          Next objFont
      
          ' fixes Excel 2013 update fonts issue
          Application.ScreenUpdating = False: ActiveSheet.Select: Application.ScreenUpdating = True
      
          ' // clean up
          Set objFont = Nothing
          Set objShell = Nothing
      
      End Sub
      
      ' // remove the Font resource upon closing the Workbook
      Private Sub Workbook_BeforeClose(Cancel As Boolean)
      
          ' // vars
          Dim objFont As OLEObject
          Dim objFilename As String
      
          ' // loop the OLE objects in the "fonts" Worksheet
          For Each objFont In Worksheets("fonts").OLEObjects
              ' // set the Filename
              objFilename = objFont.Name
              ' // remove the resource
              RemoveFontResource Environ("Temp") & Application.PathSeparator & objFilename
          Next objFont
      
          ' // clean up
          Set objFont = Nothing
      
      End Sub
      

   7. حال پنجره‌ی کد را ببندید، و به ورک‌شیت برگردید.
   8. ورک‌بوک را با پسوند فایل xlsb ذخیره و سپس ببندید (در صورت تمایل می‌توانید ورک‌شیت fonts را مخفی (Hide) کنید).

حال اگر فایل را برای فرد دیگری بفرستید که فونت شما را نداشته باشد با باز کردن فایل فونت به سیستم وی اضافه شده و می‌تواند آن را داخل لیست کشویی Font مشاهده کند.

تمام مراحلی کە در بالا توضیح داده شده‌است، در این فایل آماده انجام شدە‌ است. تنها کافیست فایل‌های داخل ورک‌شیت font را حذف کرده و آن را با فونت‌های دلخواه خودتان با انجام مراحل 3 و 4 آموزش فوق در ورک‌شیت درج کنید. با باز کردن فایل فوق و فعال کردن ماکرو قادر به مشاهده‌ی چهار فونت زیر که به صورت پیش‌فرض در سیستم‌ها وجود ندارد، خواهید بود.

در صورت تمایل می‌توانید ورک‌شیت fonts را مخفی (Hide) کرده و در سایر ورک‌شیت‌ها مطابق معمول عملیات خود را انجام دهید.