GIỮ LẠI ĐỊNH DẠNG FONT CHỮ KHI THAY ĐỔI SHAPE TRONG EXCEL

Chuyên mục:
Excel VBA

Đây là trở ngại mà dường như luôn luôn gặp phải khi tạo bảng hoặc đồ họa trong Excel. Xét ví dụ dưới đây, chúng ta bắt đầu với “Ohio” và sau đó copy nó đến các ô khác để tạo “Iowa” và “ Maine”.

Vấn đề xảy ra khi bạn cố copy cả định dạng font chữ và shape tới một địa chỉ ô khác. Vì một vài lý do, Excel muốn reset lại font chữ sau khi cách thức thay đổi. Vì vậy, bạn sẽ phải quay lại và định dạng lại font chữ cho mỗi hình ( có thể làm thủ công hoặc sử dụng Format Painter)

GIẢI PHÁP

Với giải pháp sử dụng Macro, bạn có thể chọn Shape muốn thay đổi, sau đó hiệu chỉnh link địa chỉ ô trong khi vẫn giữ nguyên định dạng text.

Mã VBA lưu trữ định dạng font trước khi công thức thay đổi và áp dụng lại tới Shape.

GIẢI PHÁP VBA MACRO

Dưới đây là mã được sử dụng thường xuyên khi tạo bảng hoặc thiết kế đồ họa, cần thiết khi trưng bày dữ liệu. Tất cả điều bạn cần làm là copy mã này vào Personal Macro workbook và truy cập nó khi cần.

Sub LinkShape_RetainFormat()
‘PURPOSE: Prevent The Resetting Of Font Format When Changing An Excel Shape’s Formula
‘SOURCE: www.TheSpreadsheetGuru.comDim shp As Shape
Dim LinkCell As Range
Dim FontBold As Boolean
Dim FontItalic As Boolean
Dim FontColor As Long
Dim FontSize As Long
Dim FontUnderline As Long
Dim FontName As String
Dim myAnswer As Variant’Determine If Selection Is A Shape
On Error GoTo InvalidSelection
Set shp = ActiveSheet.Shapes(Selection.Name)
On Error GoTo 0

‘Store Current Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
FontBold = .Bold
FontColor = .Fill.ForeColor
FontSize = .Size
FontItalic = .Italic
FontUnderline = .UnderlineColor
FontName = .Name
End With

‘Ask User For New Cell To Link To
On Error GoTo UserCancelled
Set LinkCell = Application.InputBox(“Select a single cell to link to”, Type:=8)
On Error GoTo 0

‘Change Shape’s Cell Link
If LinkCell.Parent.Name = ActiveSheet.Name Then
Selection.Formula = “=” & LinkCell.Cells(1, 1).Address
Else
Selection.Formula = “='” & LinkCell.Parent.Name & “‘!” & LinkCell.Cells(1, 1).Address
End If

‘Restore Original Font Settings
With Selection.ShapeRange.TextFrame2.TextRange.Font
.Bold = FontBold
.Fill.ForeColor.RGB = FontColor
.Size = FontSize
.Italic = FontItalic
.UnderlineColor = FontUnderline
.Name = FontName
End With

‘Scroll Back to Selected Shape
myAnswer = MsgBox(“Scroll back to graphic location?”, vbYesNo)

If myAnswer = vbYes Then
ActiveWindow.ScrollColumn = Selection.TopLeftCell.Column
ActiveWindow.ScrollRow = Selection.TopLeftCell.Row
End If

Exit Sub

‘ERROR HANDLERS
InvalidSelection:
MsgBox “Please select a shape object before running this code”
Exit Sub

UserCancelled:
Exit Sub

End Sub

[ Tùy chọn] Tự động dẫn đến ô gần nhất

Dưới đây là macro tương tự như trên, tuy nhiên có một sự thay đổi có thể xem là hữu ích như sau. Nó có chức năng tự động dẫn hộp input tới địa chỉ ô gần nhất. Điều này hữu dụng khi dữ liệu của bạn nằm cách xa so với Shape.

Sub LinkShape_RetainFormat2()
‘PURPOSE: Prevent The Resetting Of Font Format When Changing An Excel Shape’s Formula
‘SOURCE: www.TheSpreadsheetGuru.comDim shp As Shape
Dim LinkCell As Range
Dim FontBold As Boolean
Dim FontItalic As Boolean
Dim FontColor As Long
Dim FontSize As Long
Dim FontUnderline As Long
Dim FontName As String
Dim myAnswer As Variant’Determine If Selection Is A Shape
On Error GoTo InvalidSelection
Set shp = ActiveSheet.Shapes(Selection.Name)
On Error GoTo 0

‘Ask User For New Cell To Link To (Default To Current Formula)
On Error GoTo UserCancelled
Set LinkCell = Application.InputBox(“Select a single cell to link to”, _
Type:=8, Default:=Selection.Formula)
On Error GoTo 0