Fix Scriptnya donk Pak Zainul kalo boleh :D sebagai bahan pembelajaran untuk
saya dan teman" B-XL yang lain. Matur tengkyu

 

 

Salam,

 

 

ChordJR

 

 

 

From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com]
On Behalf Of zainul_ulum[at]yahoo[dot]com
Sent: Tuesday, March 26, 2013 6:12 PM
To: belajar-excel@yahoogroups.com
Subject: RE: [belajar-excel] Ambil Tabel dari web ke excel dengan VBA

 

  

Maturnuwun mas Kid,

Sarannya sudah dicoba dan berhasil.

 

Wassalam

-zainul-

 

From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com]
On Behalf Of Mr. Kid
Sent: Tuesday, March 26, 2013 5:44 PM
To: belajar-excel@yahoogroups.com
Subject: Re: [belajar-excel] Ambil Tabel dari web ke excel dengan VBA

 

  

Pak Zainul,

Coba lakukan web query. Pada object inet yang muncul dan setelah menuju url
yang diinginkan, coba hitung tanda panah kuning kecil yang muncul.
Urutan hitungnya dari kiri atas arah horisontal duluan baru ke bawahnya.
Setelah menemukan indeks tabel yang akan diambil (misal indeks tabel nomor
7), maka atur properti WebTables agar diisi dengan indeks tersebut.
nomor indeks bertipe string ya, seperti "7" dsb.

Wassalam,
Kid.




On Tue, Mar 26, 2013 at 5:35 PM, zainul_ulum[at]yahoo[dot]com
<zainul_u...@yahoo.com> wrote:

  

Be-Excel,

 

Saya membuat VBA untuk memngambil data kurs pajak mingguan sbb:

'====start vba===

Const ALAMAT_WEB As String = "http://www.depkeu.go.id/ind/currency/";

 

Sub AmbilTableKursPajakMingguan()

    Dim rgTarget As Range, aWebQry As QueryTable, sht As Worksheet

    Set sht = ActiveSheet

    

    Application.ScreenUpdating = False

    With sht.UsedRange

        If .Rows.Count > 0 Then

        .Columns.Delete 'hapus hasil query sebelumnya

        End If

    End With

 

    Set rgTarget = sht.Range("$A$1")

    Set aWebQry = ActiveSheet.QueryTables.Add(Connection:= _

        "URL;" & ALAMAT_WEB, _

        Destination:=rgTarget)

    

    With aWebQry

        .Name = "KursPajakMingguan"

        .AdjustColumnWidth = False

        .WebSelectionType = xlSpecifiedTables

        .WebTables = "1"

        .WebFormatting = xlWebFormattingNone

        .Refresh BackgroundQuery:=False

    End With

    RapihkanTable sht

    Application.ScreenUpdating = True

End Sub

 

Private Sub RapihkanTable(sht As Worksheet)

    

    sht.Columns("A:I").Delete 'hapus kolom yang kosong

    sht.Rows("1:4").Delete ' hapus baris yg kosong

    sht.Range("A5").CurrentRegion.Columns.AutoFit

    

    'rapihkan judul

    With sht.Range("A2:F4")

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .MergeCells = True

    End With

 

    Dim cn As Object

    For Each cn In sht.Parent.Connections 'menghapus connection yang ada

        cn.Delete

    Next

 

End Sub

'====end vba

Pertanyaan:

Bagaimana caranya agar yang diambil hanya table dan isinya saja? Sehingga
procedure RapihkanTable() tidak diperlukan.

JIka prosedur 

 

 



Reply via email to