自行調整儲存格字體大小

大大們, 好,
小妹有一問題請教各前輩, 可有程式設定一按鈕, 當按下按鈕時工作表中儲各存格字體便自行調整至儲存格大小,
謝謝謝!!

aa.rar (6.77 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2017-7-17 14:55 | 只看該作者

回復 1# 317
很久以前抓下的

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Shapes("放大鏡").Delete
If Application.CountA(Target) = 0 Then Exit Sub
PP = IIf(ActiveWindow.Zoom >= 100, 2, (11 - Val(Mid(ActiveWindow.Zoom, 1, 1))))
Target.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Application.ScreenUpdating = False
Paste
Shapes(Shapes.Count).Select
With Selection
.Name = "放大鏡"
.Formula = Target.Address
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.ForeColor.SchemeColor = 64
.ShapeRange.ScaleWidth PP, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight PP, msoFalse, msoScaleFromTopLeft
End With
Shapes("放大鏡").Cut
Paste Target.Offset(, Target.Columns.Count + 1)
Target.Select
Application.ScreenUpdating = True
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

317

中學生 Rank: 2

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

3^#

發表於 2017-7-17 15:46 | 只看該作者

回復 2# GBKEE
GBKEE 版大, 午安, 感謝回應
小妹要的是工作表中儲存格各有大小或合併, 而字體要遷就儲存格大小, 每次填上後, 都自工具列調整字體大小, 以便符合儲存格,
可否有程式當我填上字體, 按下執行巨集, 字體便自行調大調小, 做到符合儲存格大小,
感謝大大回應,
謝謝謝!

TOP

hong912