Hot Fox: Re: ]] XL-mania [[ get data txt dgn nama file di tentukan pada salah satu cell

quarta-feira, 21 de dezembro de 2011

Re: ]] XL-mania [[ get data txt dgn nama file di tentukan pada salah satu cell

makro yg ada telah menyediakan dialogOpenFile, sebenarnya sudah lebih gampang

dioperasikan; karena user tinggal MEMILIH FILE (dengan mouse-pointer), sisa pekerjaan

diurus olah makro

pak NurKo malah minta agar makro langsung membuka file yg namanya ditulis di

cell R7 (tanpa harus MEMILIH FILE di DialogOpenFile)

ini sepertinya (seakan-akan) lebih sederhana, karena sekali ceklik tombol, semua akan

dikerjakan oleh makro; berhubung makro telah mendapat info "nama file-text" (yg harus

di-proses) dari nilai cell R7

Itu kalau nama file yg diproses hanya "itu-itu" saja, ibarat sekali tulis, maka selama

berabad-abad hanya file dengan nama tsb yg harus diproses.

Tetapi .. jika file yg akan diproses bukan hanya satu, dan selalu berganti NAMAnya,

maka setiap akan memproses file, pak NurKo harus kerja manual dulu

baca dan salin NAMA FILE (mungkin dibaca di windows-explorer) ke clipboard,

Tulis / paste-kan NAMA FILE tadi ke cell R7

Barrru... pencet tombol makro !

( Itu kan hanya dugaanku saja, operasional yg akan benar² terjadi, hanya pak Nurko lah

yg mafhum...)

Berikut ini text code VBA makro baru (pengganti-nya) ; sedangkan di bawahnya adalah

makro sebelum diganti

Terjadi Peringkasan Code bukan karena Text-File yg dipanggil sudah tertulis di sheet,

melainkan karena pemanfaatan looping untuk mereduksi pengulangan coding...

Private Sub CommandButton1_Click()

'--------------------------------------

' coded by indri Hapsari / 21 Dec 2011

' XL-mania Case # 19750

'-------------------------------------

Dim TxtLine As String, FName As String

Dim CellDat As Variant, lRow As Long, i As Integer

Dim Pos, Num, Col, Fs, F

FName = ThisWorkbook.Path & "\" & Range("R7").Value

Set Fs = CreateObject("Scripting.FileSystemObject")

Set F = Fs.OpenTextFile(FName, 1)

Pos = Split("0\1\4\8\12\13\16\54\63\69\73\95", "\")

Num = Split("0\2\3\3\1\3\3\6\3\2\4\15", "\")

Col = Split("0\2\3\4\5\6\7\9\11\12\14\15", "\")

lRow = lRow + 1

TxtLine = F.ReadLine

If TxtLine = vbNullString Then Exit Do

For i = 1 To 11

CellDat = Mid(TxtLine, Pos(i), Num(i))

If i = 11 Then CellDat = Val(Trim(Mid(TxtLine, Pos(i), Num(i))))

Cells(lRow, CLng(Col(i)) - 1).Value = CellDat

Next i

Loop

F.Close

End Sub

=========

sebelum diganti

Private Sub CommandButton1_Click()

Dim fs, f

Dim textTerpilih1, textTerpilih2, textTerpilih3, textTerpilih4, textTerpilih5, TextTerpilih6, textTerpilih7, textTerpilih8, textTerpilih9, textTerpilih10 As String

FiletoOpen = Application _

.GetOpenFilename("Get Text Files(*.txt),*.txt", , "Select", , False)

If VarType(FiletoOpen) = vbBoolean Then

Exit Sub

End If

Set fs = CreateObject("Scripting.FileSystemObject")

Set txtFile = fs.OpenTextFile(FiletoOpen, 1, -2)

Baris = 0

Do While Not (txtFile.atendofstream)

Baris = Baris + 1

txtline = txtFile.ReadLine

textTerpilih1 = Mid(txtline, 1, 2)

textTerpilih2 = Mid(txtline, 4, 3)

textTerpilih3 = Mid(txtline, 8, 3)

textTerpilih4 = Mid(txtline, 12, 1)

textTerpilih5 = Mid(txtline, 13, 3)

textTerpilih6 = Mid(txtline, 16, 3)

textTerpilih7 = Mid(txtline, 54, 6)

textTerpilih8 = Mid(txtline, 63, 3)

textTerpilih9 = Mid(txtline, 69, 2)

textTerpilih10 = Mid(txtline, 73, 4)

textTerpilih11 = Trim(Mid(txtline, 95, 15))

Worksheets("Sheet2").Cells(Baris, 2).Value = textTerpilih1

Worksheets("Sheet2").Cells(Baris, 3).Value = textTerpilih2

Worksheets("Sheet2").Cells(Baris, 4).Value = textTerpilih3

Worksheets("Sheet2").Cells(Baris, 5).Value = textTerpilih4

Worksheets("Sheet2").Cells(Baris, 6).Value = textTerpilih5

Worksheets("Sheet2").Cells(Baris, 7).Value = textTerpilih6

Worksheets("Sheet2").Cells(Baris, 9).Value = textTerpilih7

Worksheets("Sheet2").Cells(Baris, 11).Value = textTerpilih8

Worksheets("Sheet2").Cells(Baris, 12).Value = textTerpilih9

Worksheets("Sheet2").Cells(Baris, 14).Value = textTerpilih10

Worksheets("Sheet2").Cells(Baris, 15).Value = textTerpilih11

Loop

txtFile.Close

End Sub

From: <nurkomardi@gmail.com>
Date: 2011/12/20

Mohon Bantuan koding tambahan macros agar bisa pada saat mau ambil data txt nama file sesuai dgn yg kita ingin kan pada cell "Nama" ( Cell Kuning ) sehingga tidak perlu lagi memilih file pada Popup getOpenFile
jadi kita hanya perlu menuliskan nama file pada cell kuning dan tinggal klik button maka data pada file text tsb akan bisa masuk ke sheet ini.terima kasih atas bantuannya
Contoh file terlampir

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (2)

Recent Activity:

New Members 80

Visit Your Group

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| ayooo... coba cari XL-mania di linkedin.com                       |
| momods kebanyakan e-mail :(... unread di kantor 6 ribu lebih :(   |
+-------------------------------------------------------------------+
| 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              |
+-------------------------------------------------------------------+

MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.