เซลที่ใช้ wrap text จะใช้ shrink to fit โดย VBA ได้ไหมครับ ?

[nengba]

เซลทุกเซลจะมีข้อความที่ลิ้งค์มาอยู่ 2 บรรทัด (ใช้ wrap text) โดยบรรทัดบนจะยาวกว่าบรรทัดล่างเสมอ บางข้อความยาวเกินขนาดเซล
.
ต้องการเซ็ตขนาดตัวอักษรโดยอัตโนมัติ แบบ shrink to fit โดยใช้ สูตร excel หรือ VBA จะได้หรือไม่ครับ ?

[snasui]

กรุณาแนบไฟล์ตัวอย่าง พร้อมแสดงให้เห็นว่าต้องการคำตอบเป็นอย่างไรมาด้วยจะได้สะดวกในการทำความเข้าใจครับ

[nengba]

ตัวอย่างครับ

[snasui]

ปรับสูตรใหม่เป้นด้านล่างครับ

=source!B2 & source!C2

เมื่อ Wrap แล้วจะปรับการตัดบรรทัดให้อัตโนมัติตามความกว้างคอลัมน์ครับ

[nengba]

ขอบคุณครับคุณคนควน
.
แต่ต้องการให้ข้อความจาก source!B2 อยู่บรรทัดบน และ source!C2 อยู่บรรทัดล่างครับ

[snasui]

สุตรเดิมก็เป็นเช่นนั้นอยู่แล้วนี่ครับ ช่วยจับภาพให้เห็นว่าต้องการให้มีลักษณะอย่างไรมาอีกรอบครับ

[nengba]

2017-06-16_062812.jpg

ต้องการแบบ A ครับ
.
ขนาดฟ้อนต์ทั้งชีท 16 (ในไฟล์ตัวอย่างผมใช้ 14 ขออภัยด้วยครับ) ความกว้างของเซลในชีทงานจริง 50
.
ต้องการให้ข้อความจาก source!B2 อยู่บรรทัดบน ตัดคำที่หมดข้อความจาก source!B2
.
ข้อความจาก source!C2 อยู่บรรทัดล่าง ตามรูปครับ

[snasui]

สูตรเดิมเป็นตามภาพ A อยู่แล้วครับตามภาพด้านล่างครับ

กรุณาอธิบายมาอย่างละเอียดว่าตามภาพ A ที่ทำมาเองแล้วนั้นไม่ตรงกับที่ต้องการอย่างไรหรือต้องการให้เป็นแบบใดครับ

[nengba]

2017-06-16_080631.jpg

เซลแรกกับเซลสุดท้ายบรรทัดที่ 2 หายไปครับ KKKKK ในเซลแรก AAAAA ในเซลสุดท้าย

2017-06-16_080815.jpg

ต้องการให้เป็นแบบนี้ครับ

[snasui]

ผมเข้าใจว่าต้องการให้แสดงความกว้างของบรรทัดแบบอัตโนมัติให้พอดีกับข้อความที่อยู่ในเซลล์ที่เกิดจากการเชื่อมกันด้วยสูตร

การทำเช่นนั้นให้คัดลอกเซลล์ที่มีสูตรไปวางแบบค่าในคอลัมน์หลัง ๆ กำหนดความกว้างตามต้องการแล้วกำหนดการ WrapText จากนั้นสามารถที่จะใช้คอลัมน์นี้เป็นตัวแสดงความกว้างอัตโนมัติได้

เมื่อทำตามด้านบนแล้วสามารถกำหนดความกว้างบรรทัดโดยอัตโนมัติ วิธีการคือ ให้คลิกเลือกปุ่ม Select All (ปุ่มมุมบนซ้ายก่อนบรรทัดที่ 1 และคอลัมน์ A) จากนั้นนำเมาส์ไปชี้ที่หัวบรรทัดตรงเส้นแบ่งบรรทัดแล้วดับเบิ้ลคลิกครับ

[nengba]

ขอบคุณครับ

[nengba]

เคยเสิร์ชเจอ VBA ของฝรั่ง นับจำนวนอักษรในเซลเพื่อกำหนดขนาดฟอนต์ ลองใช้ดูมันไม่ทำงานครับ ผมคงใช้ไม่เป็น หรือเป็นเพราะฟอร์แมทเซลที่มี wrap text ก็ไม่ทราบครับ

[snasui]

หากใช้ VBA ย่อมทำงานได้แทบทุกอย่างที่ต้องการ ขึ้นอยู่กับผู้ใช้งานครับ

[nengba]

รบกวนคุณคนควนชี้แนะด้วยครับ

[snasui]

การใช้ VBA จำเป็นต้องเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบนจึงจะชี้แนะได้ครับ

[nengba]

ผมเจอสคริปต์นี้ในฟอรั่มหนึ่ง ที่บอกว่าลองแล้วมันไม่ทำงานครับ

Sub DoReformat() Dim rCell As Range


For Each rCell In Selection.Cells
If Len(rCell.Text) < 46 Then
rCell.Font.Size = 19
ElseIf Len(rCell.Text) < 70 Then
rCell.Font.Size = 17
ElseIf Len(rCell.Text) < 80 Then
rCell.Font.Size = 16
ElseIf Len(rCell.Text) < 96 Then
rCell.Font.Size = 15
ElseIf Len(rCell.Text) < 139 Then
rCell.Font.Size = 13
ElseIf Len(rCell.Text) < 183 Then
rCell.Font.Size = 11
ElseIf Len(rCell.Text) < 240 Then
rCell.Font.Size = 10.5
ElseIf Len(rCell.Text) < 285 Then
rCell.Font.Size = 9
ElseIf Len(rCell.Text) < 335 Then
rCell.Font.Size = 8.5
ElseIf Len(rCell.Text) < 80 Then
Else
rCell.Font.Size = 7.5
End If
Next
End Sub

[snasui]

กรุณาเขียน Code ในฟอรัมให้เป็นไปตามกฎการใช้บอร์ดข้อ 5 ด้านบน

แนบ Code มาในไฟล์พร้อมแนบมาที่ฟอรัมด้วยจะได้สะดวกในการทดสอบครับ

[nengba]

2017-06-18_084321.jpg

แบบนี้ครับ

[snasui]

ตัดบรรทัด Dim ลงเป็นบรรทัดล่าง Code ก็จะทำงานได้ครับ

[nengba]

ขอบคุณคุณคนควนมากครับ

มันขาด ๆ เกิน ๆ ทำงานบ้าง ไม่ทำบ้าง รบกวนคุณคนควนครับ

จากสคริปต์นี้ถ้าปรับให้ดีแล้ว สามารถทำเป็น addin เพื่อเลือกใช้ในแต่ละกรณี จะได้ไหมครับ ?