Re : Récup de donner spécifique dans une page web spécifique.
bon voila le script un peu long mais efficace.
Sub ObtentionFBgn()
Sheets("ListeFBgn v3").Select
ActiveCell.Offset(1, 0).Range("A1").Select
w = "URL;http://flybase.org/reports/" & ActiveCell.Value
x = ActiveCell.Row
y = ActiveCell.Column
If ActiveCell = Empty Then Exit Sub
If (x / 25) = Int(x / 25) Then
Application.DisplayAlerts = False
ActiveWorkbook.Save
'ActiveWorkbook.Close
'Workbooks.Open Filename:= _
' "H:\CROZATIER-VINCENT_Commun Equipe\ModENCODE\dataS13v4.xlsm", UpdateLinks _
' :=0
Application.DisplayAlerts = True
End If
'import CG+Nom à partir de FB
ActiveWorkbook.Worksheets.Add before:=Worksheets(1)
With ActiveSheet.QueryTables.Add(Connection:= _
w, Destination:=Range("$A$1") _
)
.Name = "nom"
.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 = """top_table"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'copier/coller
Sheets(1).Select
With Sheets(1)
'si rien d'extrait
If ActiveCell = "" then goto suite
'Résumé
Sheets("ListeFBgn v3").Cells(x, y + 1) = Sheets(1).Cells(Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row, Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Column)
'Annotation Symbol
Sheets("FBgn").Cells(x, y + 2) = Sheets(1).Cells(Cells.Find(What:="Annotation symbol", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row, Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Column)
End With
suite:
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Call ObtentionFBgn
End Sub