Új hozzászólás Aktív témák

• #22375 bepken veterán

  Új Válasz 2014-07-09 16:25:45 #22375

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  bepken

  veterán

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row = Range("link").Row And _
  Target.Column = Range("link").Column Then
  
  'link = InputBox("másold be a linket")
  
  Dim IE As New InternetExplorer
  IE.Visible = False
  IE.navigate Range("link").Value
  
  Do
  DoEvents
  Loop Until IE.readyState = READYSTATE_COMPLETE
  Dim Doc As HTMLDocument
  Set Doc = IE.document
  Dim sTD As String
  
  std1 = Trim(Doc.getElementsByTagName("td")(5).innerText)
  std2 = Trim(Doc.getElementsByTagName("td")(7).innerText)
  std3 = Trim(Doc.getElementsByTagName("td")(8).innerText)
  std4 = Trim(Doc.getElementsByTagName("td")(9).innerText)
  std5 = Trim(Doc.getElementsByTagName("td")(11).innerText)
  std6 = Trim(Doc.getElementsByTagName("td")(12).innerText)
  std7 = Trim(Doc.getElementsByTagName("td")(13).innerText)
  std8 = Trim(Doc.getElementsByTagName("p")(1).innerText)
  
  IE.Quit
  
  Dim CurrentRow
  CurrentRow = ActiveCell.Row
  
  Cells(CurrentRow, 1).Value = std1
  Cells(CurrentRow, 2).Value = std2
  Cells(CurrentRow, 3).Value = std3
  Cells(CurrentRow, 4).Value = std4
  Cells(CurrentRow, 5).Value = std5
  Cells(CurrentRow, 6).Value = std6
  Cells(CurrentRow, 7).Value = std7
  Cells(CurrentRow, 8).Value = std8
  
  End If
  End Sub

  jelenleg itt tartok, az OLX hirdetésekkel tesztelgetem. a tutorial videók alapján valahogy nem akart kijönni az a használati mód, amire nekem szükségem van, szóval ez elég csúnyácska, lassúcska...de legalább "múkodj"

Új hozzászólás Aktív témák