XL2000: Jak pomocí makra nastavit výšku a šířku sloupce

ID článku: 213422 - Produkty, které se vztahují k tomuto článku.
Rozbalit všechny záložky | Minimalizovat všechny záložky

Souhrn

Aplikace Microsoft Excel používá písmo přiřazené stylu Normální jako základ pro šířky sloupců. Neexistuje žádný přímý způsob přiřazování šířky sloupců přesně v palce nebo centimetry bez chyby a zkušební verze.

V aplikaci Excel založen jeho měření šířky sloupců na počet číslic (konkrétně počet nul) ve sloupci písmo normálního stylu. (Některá písma, které mají číslic o různých šířkách, ale je to neobvyklé.)

Například pomocí výchozího písma, sloupec s šířkou 10 odkazuje na šířku sloupce, které jsou potřebné k zobrazení 10-tučné, bez kurzívy, Arial 10 bodů nuly. V počítači Macintosh tvoří tento stejnou šířku sloupce 10-tučné, kurzíva non Ženeva nuly 10 bodů. Aplikace Excel používá k určení šířky sloupců tak, aby při změně písma, stylu na listu sloupce zvětšit nebo zmenšit na zadaný počet číslic se zobrazí ve sloupci číslic.

Poznámka, že tato metoda stanovení šířky sloupců není přesnou při je použijte i jiné znaky, například mezery, znaky dolaru, závorky a tak dále.

Tento článek obsahuje ukázková aplikace Microsoft Visual Basic pro aplikace makra, které umožňují nastavit řádku výšku a šířku sloupce v palcích nebo centimetrech.

Další informace

Společnost Microsoft poskytuje ukázky programování pouze pro ilustraci bez žádné záruky výslovně uvedené nebo předpokládané, včetně, ale nikoli výhradně, mlčky předpokládaných záruk obchodovatelnosti nebo vhodnosti pro určitý účel. Tento článek předpokládá, že jste obeznámeni s programovacím jazykem, je prokázána a nástroje, které slouží k vytvoření a ladění skriptu. Pracovníci podpory společnosti Microsoft mohou vysvětlit funkce určitého postupu, ale nemohou tyto příklady rozšířit o další funkce nebo konstrukce podle specifických potřeb.
Jestliže nejste zkušenými programátory, můžete kontaktovat Microsoft Certified Partner nebo poradenské služby společnosti Microsoft. Další informace naleznete na těchto webech společnosti Microsoft:

Microsoft Certified partnery- https://partner.microsoft.com/Global/30000104

Poradenské služby společnosti Microsoft- http://support.microsoft.com/gp/advisoryservice

Další informace o možnostech podpory, které jsou k dispozici a o možnostech kontaktování společnosti Microsoft navštivte následující Web společnosti Microsoft:http://support.microsoft.com/default.aspx?scid=fh;EN-US;CNTACTMSNásledující makra aplikace Visual Basic lze použijte k určení šířky řádků a sloupců v centimetrech.
Sub RowHeightInInches()
    Dim inches As Single
    ' Get the desired column width.
    inches = Application.InputBox("Enter Row Height in Inches", _
        "Row Height (Inches)", Type:=1)
    ' If the cancel button was not pressed.
    If inches Then
        ' Convert and set the column height.
        Selection.RowHeight = Application.InchesToPoints(inches)
    End If
End Sub
				
Sub ColumnWidthInInches()
    Dim inches As Single, points As Integer, savewidth As Integer
    Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
    Dim Count As Integer

    ' Turn screen updating off.
    Application.ScreenUpdating = False
    ' Ask for the desired width in inches.
    inches = Application.InputBox("Enter Column Width in Inches", _
        "Column Width (Inches)", Type:=1)
    ' If the cancel button for the input box is pressed, exit the
    ' procedure.
    If inches = False Then Exit Sub
    ' Convert the entered inches to points.
    points = Application.InchesToPoints(inches)
    ' Save the current column width setting.
    savewidth = ActiveCell.ColumnWidth
    ' Set the column width to the maximum allowed.
    ActiveCell.ColumnWidth = 255
    ' If points wanted is greater than points for 255 characters.
    If points > ActiveCell.Width Then
        ' Display a message box (the specified size is too large), and
        ' let user know maximum allowed value.
        MsgBox "Width of " & inches & " is too large." & Chr(10) & _
            "The maximum value is " & Format(ActiveCell.Width / 72, _
            "0.00"), vbOKOnly + vbExclamation, "Width Error"
        ' Reset the column width back to the original.
        ActiveCell.ColumnWidth = savewidth
        ' Exit out of the Sub from here.
        Exit Sub
    End If
    ' Set the lowerwidth and upperwidth variables.
    lowerwidth = 0
    upwidth = 255
    ' Set the column width to the middle of the allowed character range.
    ActiveCell.ColumnWidth = 127.5
    curwidth = ActiveCell.ColumnWidth
    ' Set the count to 0 so if it can't find an exact match it won't go
    ' indefinitely.
    Count = 0
    ' Loop as long as the cell width is different from width desired
    ' and the count (iterations) of the loop is less than 20.
    While (ActiveCell.Width <> points) And (Count < 20)
        ' If active cell width is less than desired cell width.
        If ActiveCell.Width < points Then
            ' Reset lower width to current width.
            lowerwidth = curwidth
            ' Set current column width to the midpoint of curwidth and
            ' upwidth.
            Selection.ColumnWidth = (curwidth + upwidth) / 2
            ' If active cell width is greater than desired width.
        Else
           ' Set upwidth to the curwidth.
           upwidth = curwidth
           ' Set column width to the mid point of curwidth and lower
           ' width.
           Selection.ColumnWidth = (curwidth + lowerwidth) / 2
        End If
        ' Set curwidth to the width of the column now.
        curwidth = ActiveCell.ColumnWidth
        ' Increment the count counter.
        Count = Count + 1
    Wend
End Sub

				
Následující makra můžete použijte k určení šířky řádků a sloupců v centimetrech.
Sub RowHeightInCentimeters()
    Dim cm As Single
    ' Get the row height in centimeters.
    cm = Application.InputBox("Enter Row Height in Centimeters", _
        "Row Height (cm)", Type:=1)
    ' If cancel button not pressed and a value entered.
    If cm Then
        ' Convert and set the row height
        Selection.RowHeight = Application.CentimetersToPoints(cm)
    End If
End Sub
				
Sub ColumnWidthInCentimeters()

    Dim cm As Single, points As Integer, savewidth As Integer
    Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
    Dim Count As Integer

    ' Turn screen updating off.
    Application.ScreenUpdating = False
    ' Ask for the width in inches wanted.
    cm = Application.InputBox("Enter Column Width in Centimeters", _
        "Column Width (cm)", Type:=1)
    ' If cancel button for the input box was pressed, exit procedure.
    If cm = False Then Exit Sub
    ' Convert the inches entered to points.
    points = Application.CentimetersToPoints(cm)
    ' Save the current column width setting.
    savewidth = ActiveCell.ColumnWidth
    ' Set the column width to the maximum allowed.
    ActiveCell.ColumnWidth = 255
    ' If the points desired is greater than the points for 255
    ' characters...
    If points > ActiveCell.Width Then
        ' Display a message box because the size specified is too
        ' large and give the maximum allowed value.
        MsgBox "Width of " & cm & " is too large." & Chr(10) & _
            "The maximum value is " & _
            Format(ActiveCell.Width / 28.3464566929134, _
            "0.00"), vbOKOnly + vbExclamation, "Width Error"
        ' Reset the column width back to the original.
        ActiveCell.ColumnWidth = savewidth
        ' Exit the Sub.
        Exit Sub
    End If
    ' Set the lowerwidth and upper width variables.
    lowerwidth = 0
    upwidth = 255
    ' Set the column width to the middle of the allowed character
    ' range.
    ActiveCell.ColumnWidth = 127.5
    curwidth = ActiveCell.ColumnWidth
    ' Set the count to 0 so if it can't find an exact match it won't
    ' go on indefinitely.
    Count = 0
    ' Loop as long as the cell width in is different from width
    ' wanted and the count (iterations) of the loop is less than 20.
    While (ActiveCell.Width <> points) And (Count < 20)
        ' If active cell width is less than desired cell width.
        If ActiveCell.Width < points Then
            ' Reset lower width to current width.
            lowerwidth = curwidth
            ' set current column width to the midpoint of curwidth
            ' and upwidth.
            Selection.ColumnWidth = (curwidth + upwidth) / 2
        ' If active cell width is greater than desired cell width.
        Else
            ' Set upwidth to the curwidth.
            upwidth = curwidth
            ' Set column width to the mid point of curwidth and lower
            ' width.
            Selection.ColumnWidth = (curwidth + lowerwidth) / 2
        End If
        ' Set curwidth to the width of the column now.
        curwidth = ActiveCell.ColumnWidth
        ' Increment the count counter.
        Count = Count + 1
    Wend
End Sub
				

Odkazy

Další informace o získání nápovědy k aplikaci Visual Basic pro aplikace klepněte na tlačítko znalostní báze Microsoft Knowledge Base:
226118 OFF2000: Prostředky programování v jazyce Visual Basic pro aplikace

Vlastnosti

ID článku: 213422 - Poslední aktualizace: 26. dubna 2011 - Revize: 5.0
Informace v tomto článku jsou určeny pro produkt:
  • Microsoft Excel 2000 Standard Edition
Klíčová slova: 
kbdtacode kbhowto kbinfo kbprogramming kbualink97 kbmt KB213422 KbMtcs
Strojově přeložený článek
Důležité: Tento článek byl přeložen pomocí software společnosti Microsoft na strojový překlad, ne profesionálním překladatelem. Společnost Microsoft nabízí jak články přeložené překladatelem, tak články přeložené pomocí software na strojový překlad, takže všechny články ve Znalostní databázi (Knowledge Base) jsou dostupné v češtině. Překlad pomocí software na strojový překlad ale není bohužel vždy dokonalý. Obsahuje chyby ve skloňování slov, skladbě vět, nebo gramatice, podobně jako když cizinci dělají chyby při mluvení v češtině. Společnost Microsoft není právně zodpovědná za nepřesnosti, chyby nebo škody vzniklé chybami v překladu, nebo při použití nepřesně přeložených instrukcí v článku zákazníkem. Společnost Microsoft aktualizuje software na strojový překlad, aby byl počet chyb omezen na minimum.
Projděte si také anglickou verzi článku:213422

Dejte nám zpětnou vazbu