Private Sub Worksheet_SelectionChange(ByVal Target As Range)
FontSize = ActiveCell.Font.Size
LargeSize = FontSize * 3
Cells.Font.Size = FontSize
ActiveCell.Font.Size = LargeSize
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'حدد الزوم او عدد تكبير الخلية
ZoomCell 2
End Sub
Private Sub ZoomCell(ZoomIn As Single)
Dim s As Range
Set s = Selection
'Get rid of any existing zoom pictures
For Each p In ActiveSheet.Pictures
If p.Name = "ZoomCell" Then
p.Delete
Exit For
End If
Next
'Create a zoom picture
s.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "ZoomCell"
With .ShapeRange
.ScaleWidth ZoomIn, msoFalse, _
msoScaleFromTopLeft
.ScaleHeight ZoomIn, msoFalse, _
msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 9
.Visible = msoTrue
.Solid
End With
End With
End With
s.Select
Set s = Nothing
End Sub
تغيير لون الخلية النشطة ولكن يجعل الخلايا كلها بدون لون اي نستخدمه في حالة عدم تلوين اي خلية داخل الشيت
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
Application.ScreenUpdating = True
End Sub
Private objCurrentCell As Range
Private OrigColorIdx As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
If objCurrentCell Is Nothing Then
Set objCurrentCell = Target
OrigColorIdx = Target.Interior.ColorIndex
Target.Interior.ColorIndex = 3
Else
objCurrentCell.Interior.ColorIndex = OrigColorIdx
Set objCurrentCell = Target
OrigColorIdx = Target.Interior.ColorIndex
Target.Interior.ColorIndex = 3
End If
Application.EnableEvents = True
End Sub