Link định dạng trong Cùng 1 file

Liên hệ QC

sofaraway

Thành viên mới
Tham gia
14/3/17
Bài viết
2
Được thích
0
Các bác cho em hỏi. Em muốn link định dạng từ 2 ô trong 2 sheet khác nhau trong cùng 1 file thì làm như thế nào.
Cụ thể giả sử em có ô A1 trong Sheet1 tô màu vàng. Em muốn ô B1 trong Sheet 2 cùng màu như ô A1 trong Sheet 1.
Nếu em đổi màu ô A1 trong SHeet 1 thì màu của ô B1 trong SHeet 2 tự đổi theo
EM cảm ơn !
 
Bạn có thể sử dụng code sau để thử xem

Cách sử dụng:
Giả sử: A1 và B1 lấy màu A1
B1 = ChangeBgrCell(A1, True)
Để True sẽ trả về 0 để cộng trừ ... , False sẽ là chuỗi rỗng
Nếu B1 chứa công thức tính toán thì:
B1 = ChangeBgrCell(A1, True) + 1000
B1 = 1000 + ChangeBgrCell(A1, True)
Nếu B1 chứa một chuỗi thì:
B1 = ChangeBgrCell(A1) & "Hello"

Nhược điểm của code là bạn phải Chọn một ô / Sheet khác thì màu mới đổi

PHP:
'Copy to Workbook Code---------------------------------------------------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Application.CalculateFull
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
  Application.CalculateFull
End Sub
'Nếu bỏ Code trên thì phải Click Double vào ô thì màu mới đổi
'Nếu Excel của bạn nhiều cell chứa công thức thì bỏ Code trên
'---------------------------------------------------------------

'Copy to Module---------------------------------------------------------------
'Code này không bỏ
  Function ChangeBgrCell(Rng As Range, Optional ByVal IsDigit As Boolean = False)
    If IsArray(Rng) Then Exit Function
    ChangeBgrCell = IIf(IsDigit, 0, "")
    With Application.Caller
      .Parent.Evaluate _
      "callChangeBgrCell(" & .Parent.Name & "!" & .Address(False, False) & "," & _
      Rng.Parent.Name & "!" & Rng.Address(False, False) & ")"
    End With
  End Function
Private Sub callChangeBgrCell(Cell As Range, frCell As Range)
  On Error Resume Next
  With Cell.Interior
      .Pattern = frCell.Interior.Pattern
      .PatternColorIndex = frCell.Interior.PatternColorIndex
      .Color = frCell.Interior.Color
      .TintAndShade = frCell.Interior.TintAndShade
      .PatternTintAndShade = frCell.Interior.PatternTintAndShade
  End With
  With Cell.Font
      .ThemeColor = frCell.Font.ThemeColor
      .TintAndShade = frCell.Font.TintAndShade
  End With
End Sub
 
Lần chỉnh sửa cuối:
Tuyệt vời. Cảm ơn bạn rất nhiều
 
Web KT
Back
Top Bottom