Cách mở siêu liên kết trên một trang tính và lưu thư mục hình ảnh một cách khôn ngoan

Làm cách nào để mở siêu liên kết trên bảng tính và lưu từng ảnh vào một thư mục khác nhau?

Tôi đang làm việc trong Excel. Tôi có 7 tờ 1000 hồ sơ mỗi.

Trong mỗi trang tính có tám cột siêu liên kết (url của siêu liên kết chứa liên kết đến hình ảnh). Mỗi siêu liên kết của bản ghi nên được mở trong một cửa sổ riêng biệt.

Ngay bây giờ tôi đang sử dụng tập lệnh này để mở tất cả các siêu liên kết cùng một lúc.

Sub OpenHyperLinks()
'Update 20141124
    Dim xHyperlink As Hyperlink
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    For Each xHyperlink In WorkRng.Hyperlinks
        xHyperlink.Follow
    Next
End Sub

Tôi có thể mở tất cả các siêu liên kết cùng một lúc, nhưng tôi thực sự muốn mở các cửa sổ chrome riêng biệt cho mỗi hàng / bản ghi để tôi có thể lưu từng hình ảnh của bản ghi vào một thư mục riêng.

Xem hình ảnh sau đây. Tôi muốn mở bản ghi 10 trong một cửa sổ, 11 trong một cửa sổ khác và cứ thế.

Hãy thử mã này. Nó đã hoạt động trên Windows 7 64 Bit của tôi với Chrome Phiên bản 62.0.3202.75.

Thông thường Chrome sẽ mở các URL tiếp theo trong Tab mới thay vì Cửa sổ mới. Vì vậy, bạn có thể không thể kiểm soát hành vi này nếu bạn sử dụng Hyperlink.Follow phương pháp trong VBA của bạn. Thủ thuật là gọi một phiên bản Chrome mới bằng chức năng Shell sau khi mỗi Hàng được xử lý để các URL tiếp theo mở trong phiên bản mới đó, v.v.

Mặc dù mã này đã hoạt động ở cuối của tôi, nhưng nó có thể hoạt động chính xác như đối tượng dự kiến ​​đối với các Phiên bản Windows OS / Chrome và cách thức thiết kế. Vì vậy, hãy thử và báo cáo lại.

Ngoài ra, việc sử dụng Shell có thể tăng tốc độ mở URL một chút và quan trọng nhất là Chrome vẫn sẽ mở URL Văn bản hợp lệ ngay cả khi nó không thực sự được giải quyết như một URL trong tài liệu Excel chỉ trong trường hợp.

  Sub OpenHyperLinks()
    On Error Resume Next
    Dim xHyperlink As String
    Dim WorkRng As Range
    Dim cell As Range
    Dim counter As Integer
    Dim col_counter As Integer
    Dim row_counter As Integer
    Dim pHandle
    Const Chrome_Path = "C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe"
    'Set above Constant Chrome_Path to match  Chrome.exe location on your PC
    counter = 0
    row_counter = 0
    Set WorkRng = Application.InputBox("Select Range", Type:=8)
    If WorkRng.Rows.Count = 0 Then
        Exit Sub
    End If
    col_counter = WorkRng.Columns.Count
    For Each cell In WorkRng
        If counter = 0 Then
            pHandle = Shell(Chrome_Path)
        End If
        xHyperlink = cell.Value
        If xHyperlink = "" Then
        Else
            pHandle = Shell(Chrome_Path & " -url " & xHyperlink)
        End If
        counter = counter + 1
        If counter = col_counter Then
           counter = 0
        End If
    Next
End Sub

Không có nhiều xác nhận trong mã. Chỉ trong trường hợp bạn hủy tại InputBox, phụ thoát ra vì không có gì để xử lý và trong trường hợp Hyperlink trống, nó sẽ bị bỏ qua. Đặt hằng số Chrome_Path để khớp với vị trí của Chrome.exe trên PC của bạn, chỉ trong trường hợp nó được cài đặt vào một thư mục / phân vùng khác trên PC của bạn.

Nếu bạn có hàng trăm URL để xử lý, cuối cùng nó có thể làm chậm PC của bạn mặc dù một số phiên bản Chrome sẽ chiếm trong bộ nhớ. Ngoài ra, bạn có thể tạm dừng sau mỗi bản ghi bằng MsgBox hoặc như vậy và đóng thủ công Chrome phiên bản mở sau khi bạn hoàn thành công việc.