Přejít k hlavnímu obsahu

Jak zvětšit nebo zvětšit vybrané buňky v aplikaci Excel? 

Jak všichni víme, Excel má funkci Lupa, která nám pomáhá zvětšit velikost hodnoty buňky v celém listu. Někdy však stačí zvětšit nebo zvětšit pouze vybrané buňky. Existují nějaké dobré nápady pro zvětšení vybraných buněk pouze v listu?

Zvětšete nebo zvětšete vybranou buňku pomocí kódu VBA


Zvětšete nebo zvětšete vybranou buňku pomocí kódu VBA

Možná tam nebude žádný přímý způsob, jak bychom mohli zvětšovat vybrané buňky v aplikaci Excel, ale zde mohu zavést kód VBA pro řešení této úlohy jako řešení. Postupujte prosím následovně:

1. Klikněte pravým tlačítkem na kartu listu, kterou chcete automaticky zvětšit vybrané buňky, a poté vyberte Zobrazit kód z kontextového menu v otevřeném Microsoft Visual Basic pro aplikace okno, zkopírujte a vložte následující kód do prázdného modulu:

Kód VBA: Zvětšení nebo zvětšení vybraných buněk:

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. Poté uložte a zavřete toto okno s kódem, nyní, když vyberete nebo kliknete na některé datové buňky, buňky se automaticky zvětší jako obrázek, viz screenshot:

Poznámka: Vybrané buňky se po výběru dalších buněk změní zpět na původní velikost.

Nejlepší nástroje pro produktivitu v kanceláři

🤖 Kutools AI asistent: Revoluční analýza dat založená na: Inteligentní provedení   |  Generovat kód  |  Vytvořte vlastní vzorce  |  Analyzujte data a generujte grafy  |  Vyvolejte funkce Kutools...
Populární funkce: Najít, zvýraznit nebo identifikovat duplikáty   |  Odstranit prázdné řádky   |  Kombinujte sloupce nebo buňky bez ztráty dat   |   Kolo bez vzorce ...
Super vyhledávání: Více kritérií VLookup    VLookup s více hodnotami  |   VLookup na více listech   |   Fuzzy vyhledávání ....
Pokročilý rozevírací seznam: Rychle vytvořte rozevírací seznam   |  Závislý rozbalovací seznam   |  Vícenásobný výběr rozevíracího seznamu ....
Správce sloupců: Přidejte konkrétní počet sloupců  |  Přesunout sloupce  |  Přepnout stav viditelnosti skrytých sloupců  |  Porovnejte rozsahy a sloupce ...
Doporučené funkce: Zaměření mřížky   |  Návrhové zobrazení   |   Velký Formula Bar    Správce sešitů a listů   |  Knihovna zdrojů (Automatický text)   |  Výběr data   |  Zkombinujte pracovní listy   |  Šifrovat/dešifrovat buňky    Odesílat e-maily podle seznamu   |  Super filtr   |   Speciální filtr (filtr tučné/kurzíva/přeškrtnuté...) ...
Top 15 sad nástrojů12 Text Tools (doplnit text, Odebrat znaky, ...)   |   50+ Graf Typ nemovitosti (Ganttův diagram, ...)   |   40+ Praktické Vzorce (Vypočítejte věk na základě narozenin, ...)   |   19 Vložení Tools (Vložte QR kód, Vložit obrázek z cesty, ...)   |   12 Konverze Tools (Čísla na slova, Přepočet měny, ...)   |   7 Sloučit a rozdělit Tools (Pokročilé kombinování řádků, Rozdělit buňky, ...)   |   ... a více

Rozšiřte své dovednosti Excel pomocí Kutools pro Excel a zažijte efektivitu jako nikdy předtím. Kutools for Excel nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času.  Kliknutím sem získáte funkci, kterou nejvíce potřebujete...

Popis


Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
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