Makrolar Intranete ulaşabilir mi?

[bistrobellman]

evet dediğiniz olabiir.ben hücereden okuturum onu offset ile..bekliyorum sizi

 

[ALPEN]

Dış veri al -> Yeni web sorgusu ile daha kolay bir çözüm.

Sorgunun sonucu "sayfa1" e gönderiliyor.

Sizin yapmanız gereken sayfa1deki istediğiniz sütunları userform'a almak.

Bunun içinde Sn. Raider'ın
http://www.excel.web.tr/viewtopic.php?p=18133#18133

linkini inceleyin.

 

[bistrobellman]

If ComboBox2.Value = "YURTICI" Then
Web.Navigate2 "http://kalite\uretimm\1dokumlerlist.asp" & "?psearch=" & TextBox21 & "&Submit=Ara+%A0%28*%29"
Do Until Web.ReadyState = 4 >>do loop döngüsünü nereye koyacam?
DoEvents
Loop
On Error Resume Next
Sheets("sayfa1").Cells.ClearContents
Sheets("sayfa1").Cells.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:= _
"http://kalite\uretimm\1dokumlerlist.asp" & "?psearch=" & TextBox21 & "&Submit=Ara+%A0%28*%29", Destination:=Range("A1"))
.Name = "1Dokumlerlist_asp"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


End If

yeni bir sayfa ekledim "sayfa1" adında...işlemleri yaptı sayfa1 e geri döndüm sadece kenarlıklar var hücrelerin içi boş neden?

KOyu renkli Do loop döngüsünü tamamen kaldırdım sonuç değişmedi neden? hata nerede?

 

[ALPEN]

Sadece son gönderdiğim dosyayı açın.
Kutucuğa bir kriter yazın, ve butona tıklayın.
Sayfa1 i kontrol edin.

 

[bistrobellman]

benim aktif olarak çalıştığım sayfa "YURTICI"

Web sayfasından özet alacak sayfa "sayfa1" olduğu için
kodları nasıl değiştireceğiz?
With ActiveSheet.QueryTables.Add(Connection:= _
yerine
With Sheets(sayfa1).QueryTables...... ekledim.<<<<<<<
Destination:=Range("A1")) yerine
Destination:=Sheets("sayfa1").Range("A1")) <<<<<<<<

olmadı..worksheets mi diyeceğiz acaba? :x

 

[ALPEN]

Anlaşamadığımız nokta şu.

Benim sizin lokal intranetinizde bulunan asp tabanlı bir sayfaya gönderdiğimiz sorgunun sonucunu görme imkanım yok. Dolayısı ile hata olduğunda, hatanın ne olduğunu bilmem çok önemli.

Bu durumda sizin yardımınız gerekiyor.

1. Son gönderdiğim dosyayı tek başına çalıştırdığınızda sorgu çalıştı mı?

2. Çalışmadı ise tam olarak verdiği hata ne?

 

[bistrobellman]

gönderdiğiniz dosyayı denedim çalışmadı sayfa1de (activesheet) hareketlenme yok.

 

[ALPEN]

Ofis sürümünüz?

 

[bistrobellman]

hata vermiyor.tıklıyorum commandbutton1 e o kadar. Exit Sub yapılmış gibi hatasız duruyor form olduğu yerde...sayfa1de de birsey yok.

WebTables = "3" te bir sorun olabilir mi?

 

[ALPEN]

Ok En baştan başlayalım.

Ã?ncelikle
Ofis sürümünüzü ve dilinizi imzanıza ekleyerek başlayalım.

 

[bistrobellman]

tamamdır ilk aşama...

 

[ALPEN]

1. Araçlar->Makro-> Yeni Makro kaydet

2. Veri -> Dış veri Al -> Yeni web sorgusu

Çıkan pencerede

Adres satırına

http://kalite\uretimm\1dokumlerlist.asp?psearch=XXXXXX&Submit=Ara+%A0%28*%29

yazın.


***Ã?nemli kırmızı XXXXXX yazan bölümü aramak istediğiniz kelime ile değiştirin.

Al'ı tılayın.

Hangi hücreden başlayacağını soraran pencereyi de tıkladıktan sonra sorgu sonucunun sayfaya aktarılmış olması gerekir.

Þimdi makro kaydını durdurup kaydettiğiniz makroyu buraya yapıştırın.

 

[bistrobellman]

Sub Makro1()

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://kalite\uretimm\1dokumlerlist.asp?psearch=534000&Submit=Ara+%A0%28*%29 " _
, Destination:=Range("A1"))
.Name = "1dokumlerlist.asp?psearch=534000&Submit=Ara+%A0%28*%29 "
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With

 

[ALPEN]

Ok
Þimdi sorgunun döndüğü sayfayı temizleyin.


kodu aşağıdaki gibi değiştirin ve makroyu tekrar çalıştırın.




[vb:1:67e248158c]Sub Makro1()

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://kalite\uretimm\1dokumlerlist.asp?psearch=534000&Submit=Ara+%A0%28*%29 " _
, Destination:=Range("A1"))
.Name = "1dokumlerlist.asp?psearch=534000&Submit=Ara+%A0%28*%29 "
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With[/vb:1:67e248158c]

 

[bistrobellman]

534000 yerine textbox21 koyuyorum çalışmıyor...textbox21 değeri sayısal bir değer...

 

[bistrobellman]

tamam textbox21 olayını hallettim...

cok teşekkür ederim elinize sağlık...

Saygılar... k:: k:: k::