Note: The other languages of the website are Google-translated. Back to English
Logga in  \/ 
x
or
x
Registrera  \/ 
x

or

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.


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2019 och 365. Stöder alla språk. Enkel distribution i ditt företag eller organisation. Fullständiga funktioner 30-dagars gratis provperiod. 60-dagars pengarna tillbaka-garanti.
kte-flik 201905

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 åt dig varje dag!
officetab botten
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    vikas vasa · 1 years ago
    Hi,

    I am using Mac-Air and it shows only the color when you click on ac particular cell, pls guide.
  • To post as a guest, your comment is unpublished.
    Mazzi · 2 years ago
    Error 1004 on line 15

    Application.ActiveSheet.Pictures.Paste.Select

    Why?, what could it be?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hi, Mazzi,
      The above code works well in my Excel workbook, which Excel version do you use?
  • To post as a guest, your comment is unpublished.
    ashraf · 2 years ago
    I want to magnify when entering the data
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hi,
      May be, there is no direct way for solving your problem, if you find a good method, please comment here.
  • To post as a guest, your comment is unpublished.
    Korkmaz · 2 years ago
    this is cool, but i want it to run in all sheets, how can i do that?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      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