oo... bageetoo to keperluannya...
kalo begitu, berhubung workbook sudah terlanjur ada makro-userform-nya
maka wrapping text terhadap data yg diinput ke textbox tidak perlu bantuan
listbox maupun range serta rumus & dummies di sheet
langsung saja : dari isi texbox di wrapped dengan UDF truss hasilnya disebar
(dengan looping) ke range yg dikehendaki
pada makro berikut; ini listbox-nya masih dipertahankan untuk sekedar dipandangi
keindahannya..
Private Sub btOK_Click()
' siti Vi / 24 jan 2011
'---------------------
Dim CommRng As Range, TxArr As Variant
Dim CommHdr As String, r As Integer
Set CommRng = Range("E18")
LstComm.Clear
CommHdr = Application.UserName & " - " & _
Format(Now, "dd MMM YYYY hh:mm")
If Len(txtInput) > 0 Then
CommRng.Offset(2, 0).CurrentRegion.ClearContents
TxArr = ctvWrap(txtInput.Value, 50)
CommRng(3, 1) = CommHdr
LstComm.AddItem CommHdr
For r = 1 To UBound(TxArr)
LstComm.AddItem TxArr(r)
CommRng(r + 3, 1) = TxArr(r)
CommRng(r + 3, 2).FormulaR1C1 = "=len(RC[-1])"
Next r
Else
CommRng.Offset(2, 0).CurrentRegion.ClearContents
End If
CommRng(1).Activate
' Unload Me
End Sub
On 1/24/11, Alex Suryadi <alex_suryadi@yahoo.com> wrote:
> Tengkiu banget bwat Mas Kid bwat solusi array nya (yg bikin saya bingung..:p )
> en Mbak Siti Vi bwat solusi yg simple bgt..(solusi 1).
>
> Sebenernya masalah saya adalah ingin menampilkan tombol Komentar di chart
> berupa userform, dimana terkendala text yg tidak rapi tsb. Mungkin ada
> solusi yg maknyus.untuk lebih jelasnya lihat lampiran.
> Salam,
> Alex
>
> ---------- Forwarded message ----------
> From: STDEV(i) <setiyowati.devi@gmail.com>
> Date: 2011/1/24
> Subject: Re: ]] XL-mania [[ WarpText
> To: XL-mania@yahoogroups.com
>
> sebetulnya...
> karea sudah ada formula sakti dari mas kid; maka solusi berikut ini
>
> menjadi gag-penting lagee
> "kita" tetap ngeyel kirim; dengah harapan untuk dilihat-lihat saja lah
>
> 1 solusi dengan meu Edit > Fill > Justify
> misal di kolom B di cell B2 tertulis datanya
> di B1 kita tulis "ruller" sbb
> '12345678901234567890123456789012345678901234567890
>
> kemudian B1 itu diformat FONT = COURIER NEW
> yaitu font yg width-nya fixed (semua karakter punya width yg sama)
> begitu juga area range dimana hasil akan dituliskan
> (misal B1:B1000)
>
> kemudian kolom B kita atur lebarnya agar pas dengan lebar data di B1 itu
>
> ("habis itu"...) kita select B2 lalu selection kita lebarkan ke bawah
> beberapa baris yg kira kira menampung hasil Fill-Justifying-nya
> lebih baik kelebihan daripada kurang...
>
> ("habis itu"...) klik menu > Edit > Fill >> Justify
> dan lihat apa yang terjadi... (mungkin ini termasuk hasil yg super dan
> mulia)
>
> seperti muridnya Oom Mario Teguh
>
> 2 dengam FORMULA array
> ( sudah dicontohkan oleh Mr Kid )
>
> Mohon dicoba pula =LEFT(E15,D15-1)
> tetapi kolom D berisi formula helper (lihat lampiran)
> Pelanggan Daily-Digest atau No-Mail/Web-Only bisa mengunduh sendiri
> di sinih: http://www.box.net/shared/gq6aymcs2k
>
> 3. dengan formula berbantu UDF
>
> =WrapFormula(B22,50)
>
> jika fungsi WrapFormula diberlakukan tanpa argument ke 3 (Index)
> maka dia harus di enter sebagai Array Formula yg ditulis sekaligus
> pada beberapa cells sekolom
>
> =WrapFormula(B22,50,1)
> =WrapFormula(B22,50,2)
>
> Di enter secara individual ( cell satu = formula biasa)
> argument ke 3 (dlm contoh 2 dan 3) adalah "index hasil ke"
>
> So misalnya hasilnya 6 baris dua formula tsb menghasilkan
> hasil (penggalan kalimat) ke 2 dan ke 3.
>
> Oiya argument ke 2 harus berisi angka bulat positip, (dlm contoh = 50)
> dia adalah max banyaknya character per sekali tekuk.
>
> Coding UDF nya ndak "macem-macem" (hanya 1 macem saja) spt ini
> Function WrapFormula(S As String, _
> L As Integer, Optional idx As Integer = 0)
> '--siti Vi / jurangmangu, 24 jan 2011
> Dim TxArr(), Txt As String
> Dim m As Integer, n As Integer
> Dim i As Integer, j As Integer
> S = Trim(S) & " "
> i = 1
> Txt = Mid(S, 1, 51)
> Do While i < Len(S)
> For j = L + 1 To 1 Step -1
> Txt = Mid(S, i, L + 1)
> If Mid(Txt, j, 1) = " " Then
> n = n + 1
> ReDim Preserve TxArr(1 To n)
> TxArr(n) = Left(Txt, j - 1)
> i = i + j
> Exit For
> End If
> Next j
> Loop
> If idx = 0 Then
> WrapFormula = WorksheetFunction.Transpose(TxArr)
> Else
> WrapFormula = TxArr(idx)
> End If
> End Function
| "if you are the most valuable assets, you will show up on the |
| balance sheet..." - oNo Wiqe |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
Nenhum comentário:
Postar um comentário