MS Excel VBA

Zoom The Selected Range In Excel Sheet With VBA

zoom inside the shape code.
				
					'For more : https://msexcelvba.com

'Zoom In Make A Shapes

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range, rng2 As Range, Zoom As Single
    Set rng = Selection
    Zoom = 1.6                            'Zoom rate
    
  For Each rng2 In Selection               'If there are blank rng2s in selection, shapes are deleted and ended method
        If rng2.Value = Empty Then
        Call delete_picture
        GoTo here:
        Exit Sub
        End If
  Next
   
 Call delete_picture                        'Remove any existing zoom pictures
  Application.ScreenUpdating = False
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture      'Create zoom picture
    ActiveSheet.Pictures.Paste.Select
        With Selection
        .Name = "zoom"
        With .ShapeRange
            .ScaleWidth Zoom, msoFalse, msoScaleFromTopLeft
            .ScaleHeight Zoom, msoFalse, msoScaleFromTopLeft
        With .Fill
             .ForeColor.SchemeColor = 44
             .Visible = msoTrue
             .Solid
             .Transparency = 0
            End With
        End With
    End With
 
here:
    rng.Select
    Application.ScreenUpdating = True
    Set rng = Nothing
End Sub

Sub delete_picture()                           'Remove any existing zoom pictures
Dim O As Object
For Each O In ActiveSheet.Pictures
        If O.Name = "zoom" Then
            O.Delete
        End If
    Next
End Sub


				
			
zoom desired the fonts size.
				
					'For more : https://msexcelvba.com

Private STR As String, STR1 As String, STR2 As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Range(STR1).Font.Size = STR
Range(STR1).Width = STR2

If Target <> Empty Then
STR = Target.Font.Size
STR1 = Target.Address
STR2 = Target.Width
'MsgBox STR2
Target.Font.Size = STR * 1.7     'You can type the desired font size here
Target.EntireColumn.AutoFit
Else
Target.Font.Size = STR
Target.Width = STR2
End If
End Sub



				
			

Code Explanation zoom shape.

				
					Dim rng As Range, rng2 As Range, Zoom As Single
    Set rng = Selection
				
			
Declare variables and set the range in mouse selection
				
					Zoom = 1.6
				
			
set the Zoom rate
				
					 For Each rng2 In Selection 
      If rng2.Value = Empty Then
        Call delete_picture
        GoTo here:
        Exit Sub
        End If
  Next
				
			
If there are blank rng2s in selection, shapes are deleted and ended method
				
					Call delete_picture  
				
			
Delete any existing zoom pictures
				
					 Application.ScreenUpdating = False
				
			
Screen-updating object to false then it will speed up the macro
				
					  rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
  ActiveSheet.Pictures.Paste.Select
        With Selection
        .Name = "zoom"
        With .ShapeRange
            .ScaleWidth Zoom, msoFalse, msoScaleFromTopLeft
            .ScaleHeight Zoom, msoFalse, msoScaleFromTopLeft
        With .Fill
             .ForeColor.SchemeColor = 44
             .Visible = msoTrue
             .Solid
             .Transparency = 0
            End With
        End With
    End With
 
here:
  rng.Select
    Application.ScreenUpdating = True
    Set rng = Nothing
				
			
Create a zoom picture and screen updating turn on
				
					Sub delete_picture()
Dim O As Object
For Each O In ActiveSheet.Pictures
        If O.Name = "zoom" Then
            O.Delete
        End If
    Next
End Sub
				
			
Delete any existing zoom pictures subject
zoom inside the Fonts Size code.
				
					'For more : https://msexcelvba.com

Private STR As String, STR1 As String, STR2 As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Range(STR1).Font.Size = STR
Range(STR1).Width = STR2

If Target <> Empty Then
STR = Target.Font.Size
STR1 = Target.Address
STR2 = Target.Width
'MsgBox STR2
Target.Font.Size = STR * 1.7     'You can type the desired font size here
Target.EntireColumn.AutoFit
Else
Target.Font.Size = STR
Target.Width = STR2
End If
End Sub


				
			

Code Explanation Font Size.

				
					Private STR As String, STR1 As String, STR2 As String
				
			
Declare variables
				
					On Error Resume Next
				
			
if any error skip it go to next line
				
					Range(STR1).Font.Size = STR
Range(STR1).Width = STR2
				
			
Set range font size with variables
				
					If Target <> Empty Then
				
			
if condition if current selection empty then code run
				
					STR = Target.Font.Size
STR1 = Target.Address
STR2 = Target.Width
				
			
Set variables
				
					Target.Font.Size = STR * 1.7
				
			
(Fonts size );You can type the desired font size here
				
					Target.EntireColumn.AutoFit
				
			
Selection Column Automatically fit as per our font size
				
					Else
Target.Font.Size = STR
Target.Width = STR2
End If
				
			
Otherwise font size same

Leave a Comment

Your email address will not be published. Required fields are marked *


Scroll to Top