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

• #46346 lcdtv tag

  Új Válasz 2021-03-30 13:52:16 #46346

  Ú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

  

  lcdtv

  tag

  Ha valakinek kellene. A cellatartalom hyperlink kell, hogy legyen (ez nálam hiba volt), mivel több száz F2+entert nem akartam nyomogatni ezért van ez a script. Ez minden cella adatból hyperlinket csinál.
  Sub HyperAdd()
'Converts each text hyperlink selected into a working hyperlink

Dim xCell As Range

For Each xCell In Selection
ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
Next xCell
End Sub
  majd ez a script meg letölti egy adott könyvtárba
  Const TargetFolder = "C:\temp\"
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long
#End If

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Const folderName As String = "c:\temp\"

Sub MyFileDownload()
For Each Hyperlink In ActiveSheet.Hyperlinks
For N = Len(Hyperlink.Address) To 1 Step -1
If Mid(Hyperlink.Address, N, 1) <> "/" Then
LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
Else
Exit For
End If
Next N
Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
LocalFileName = “”
Next Hyperlink

End Sub

Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub
Sub bcvb()
End Sub

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