Hoppa till huvudinnehåll

Hur zooma eller förstora valda celler i Excel? 

Som vi alla vet har Excel en zoomfunktion som hjälper oss att öka storleken på cellvärdet i hela kalkylbladet. Men ibland behöver vi bara zooma eller förstora bara de valda cellerna. Finns det några bra idéer för oss att förstora de valda cellerna endast i ett kalkylblad?

Zooma eller förstora den valda cellen med VBA-kod


Zooma eller förstora den valda cellen med VBA-kod

Kan inte finnas på något direkt sätt för oss att förstora de valda cellerna i Excel, men här kan jag införa en VBA-kod för att hantera det här jobbet som en lösning. Gör så här:

1. Högerklicka på arkfliken som du vill förstora de markerade cellerna automatiskt och välj sedan Visa kod från snabbmenyn, i den öppnade Microsoft Visual Basic för applikationer fönster, kopiera och klistra in följande kod i den tomma modulen:

VBA-kod: Zooma eller förstora de markerade cellerna:

Private Sub worksheet_selectionchange(ByVal Target As Range)
'Updateby Extendoffice
    Dim xRg As Range
    Dim xCell As Range
    Dim xShape As Variant
    Set xRg = Target.Areas(1)
    For Each xShape In ActiveSheet.Pictures
        If xShape.Name = "zoom_cells" Then
            xShape.Delete
        End If
    Next
    If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
    Application.ScreenUpdating = False
    xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
    Application.ActiveSheet.Pictures.Paste.Select
    With Selection
        .Name = "zoom_cells"
        With .ShapeRange
            .ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
            With .Fill
                .ForeColor.SchemeColor = 44
                .Visible = msoTrue
                .Solid
                .Transparency = 0
            End With
        End With
    End With
    xRg.Select
    Application.ScreenUpdating = True
    Set xRg = Nothing
End Sub

2. Spara och stäng sedan detta kodfönster, nu när du väljer eller klickar på några dataceller förstoras cellerna automatiskt som en bild, se skärmdump:

Anmärkningar: De valda cellerna ändras tillbaka till originalstorlek efter att andra celler har valts.

Bästa kontorsproduktivitetsverktyg

🤖 Kutools AI Aide: Revolutionera dataanalys baserat på: Intelligent utförande   |  Generera kod  |  Skapa anpassade formler  |  Analysera data och generera diagram  |  Anropa Kutools funktioner.
Populära funktioner: Hitta, markera eller identifiera dubbletter   |  Ta bort tomma rader   |  Kombinera kolumner eller celler utan att förlora data   |   Rund utan formel ...
Superuppslag: Flera kriterier VLookup    VLookup med flera värden  |   VSök över flera ark   |   Fuzzy Lookup ....
Avancerad rullgardinslista: Skapa snabbt en rullgardinslista   |  Beroende rullgardinslista   |  Flervals-rullgardinslista ....
Kolumnhanterare: Lägg till ett specifikt antal kolumner  |  Flytta kolumner  |  Växla synlighetsstatus för dolda kolumner  |  Jämför intervall och kolumner ...
Utvalda funktioner: Rutnätsfokus   |  Designvy   |   Stor formelbar    Arbetsbok & Bladhanterare   |  Resursbibliotek (Automatisk text)   |  Datumväljare   |  Kombinera arbetsblad   |  Kryptera/Dekryptera celler    Skicka e-postmeddelanden efter lista   |  Superfilter   |   Specialfilter (filtrera fet/kursiv/genomstruken...) ...
Topp 15 verktygssatser12 text verktyg (lägga till text, Ta bort tecken, ...)   |   50+ Diagram Typer (Gantt Chart, ...)   |   40+ Praktiskt Formler (Beräkna ålder baserat på födelsedag, ...)   |   19 Införande verktyg (Infoga QR-kod, Infoga bild från sökväg, ...)   |   12 Konvertering verktyg (Siffror till ord, Valutaväxling, ...)   |   7 Slå ihop och dela verktyg (Avancerade kombinera rader, Dela celler, ...)   |   ... och mer

Uppgradera dina Excel-färdigheter med Kutools för Excel och upplev effektivitet som aldrig förr. Kutools för Excel erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid.  Klicka här för att få den funktion du behöver mest...

Beskrivning


Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
Comments (10)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Ragazzi perso cos' non posso correggere la singola cella...esiste un modo per ingrandire la singola cella una volta selezionata e lavorarci sopra ?
This comment was minimized by the moderator on the site
Hi,
This is great - thank you.

Would it be possible to only have this on a selection of cells on a sheet? For example, all cells in column A, or A3 to A26 for example?
Thank you!
Rhys
This comment was minimized by the moderator on the site
Hi,
I am using Mac-Air and it shows only the color when you click on ac particular cell, pls guide.
This comment was minimized by the moderator on the site
I have the same issue on my MBA M2 running Excel V16.62, blue background but no text seen
This comment was minimized by the moderator on the site
Error 1004 on line 15

Application.ActiveSheet.Pictures.Paste.Select

Why?, what could it be?
This comment was minimized by the moderator on the site
Hi, Mazzi,
The above code works well in my Excel workbook, which Excel version do you use?
This comment was minimized by the moderator on the site
I want to magnify when entering the data
This comment was minimized by the moderator on the site
Hi,
May be, there is no direct way for solving your problem, if you find a good method, please comment here.
This comment was minimized by the moderator on the site
this is cool, but i want it to run in all sheets, how can i do that?
This comment was minimized by the moderator on the site
Hi, Ahmet,
To apply this operation in all worksheets, you can use the below vba code. (You should put the code into the ThisWorkbook module).Please try it.
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)
For Each xShape In ActiveSheet.Pictures
If xShape.Name = "zoom_cells" Then
xShape.Delete
End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "zoom_cells"
With .ShapeRange
.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End Sub
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations