Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Giờ với đoạn code trên OT muốn sửa không phải mở cửa sổ để lựa chọn các file muốn nữa mà thay vì thế thì sẽ liệt kê tên các file đó trong các ô tại bảng tính ví dụ A1:A10 của sheet1 thì code trên phải sửa lại thế nào ạ?
Trời, đến giờ mà bạn còn hỏi cái sơ đẳng ...

Hiện thời code hiển thị tên các tập tin được chọn trong MsgBox (không phải mở cửa sổ để lựa chọn các file thì làm gì có chúng để mà hiển thị hay không). Bây giờ bạn không muốn MsgBox mà liệt kê các tên trong cột A?
1.
Mã:
Dim filename As String

2. Thay
Mã:
MsgBox "Selected item's path: " & vrtSelectedItem

bằng
Mã:
filename = vrtSelectedItem     ' toàn bộ đường dẫn
filename = Mid(filename, InStrRev(filename, "\") + 1)     ' chỉ tên tập tin
ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = filename

Cái ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp) và Offset bạn đã từng đọc, từng viết không biết bao nhiêu lần rồi.
 
Upvote 0
Trời, đến giờ mà bạn còn hỏi cái sơ đẳng ...

Hiện thời code hiển thị tên các tập tin được chọn trong MsgBox (không phải mở cửa sổ để lựa chọn các file thì làm gì có chúng để mà hiển thị hay không). Bây giờ bạn không muốn MsgBox mà liệt kê các tên trong cột A?
1.
Mã:
Dim filename As String

2. Thay
Mã:
MsgBox "Selected item's path: " & vrtSelectedItem

bằng
Mã:
filename = vrtSelectedItem     ' toàn bộ đường dẫn
filename = Mid(filename, InStrRev(filename, "\") + 1)     ' chỉ tên tập tin
ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = filename

Cái ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp) và Offset bạn đã từng đọc, từng viết không biết bao nhiêu lần rồi.
Dạ con chào Bác,
Vâng đúng là con rất ít để ý đến vấn đề này, giờ con mới tìm hiểu kỹ hơn để xử lý ạ.
Ý con thế này Bác., trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi Bác ạ.
Sau khi lựa chọn các file đó xong nó mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate gì đó cũng được ạ.
------
Ngoài ra Bác cho con hỏi thêm với có cái nào hơn 'FileDialog" không ạ,như là hơn về tốc độ, hoặc hơn về mở được mọi đường dẫn (có dấu hoặc các thứ tiếng ạ ...
Con cảm ơn Bác đã giúp đỡ con.
 
Upvote 0
Dạ con chào Bác,
Vâng đúng là con rất ít để ý đến vấn đề này, giờ con mới tìm hiểu kỹ hơn để xử lý ạ.
Ý con thế này Bác., trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi Bác ạ.
Sau khi lựa chọn các file đó xong nó mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate gì đó cũng được ạ.
------
Ngoài ra Bác cho con hỏi thêm với có cái nào hơn 'FileDialog" không ạ,như là hơn về tốc độ, hoặc hơn về mở được mọi đường dẫn (có dấu hoặc các thứ tiếng ạ ...
Con cảm ơn Bác đã giúp đỡ
Bạn dùng đoạn code này, nó cũng hiện msgbox từng file như trên và tôi nghĩ bạn có thể dễ dàng tùy biến để dùng:

Rich (BB code):
Sub SelectFilesInRange()
Dim Rg As Range, Cll As Range, MyPath As String, X
MyPath = ThisWorkbook.Path & "\"

On Error Resume Next
Set Rg = Application.InputBox("Quét 1 vùng", "Vùng quét", Type:=8)
If Err.Number = 424 Then
  MsgBox "Loi: chua chon vung!"
  Exit Sub
Else
   For Each Cll In Rg
       MsgBox MyPath & Cll.Value
   Next
End If
End Sub
 
Upvote 0
Bạn dùng đoạn code này, nó cũng hiện msgbox từng file như trên và tôi nghĩ bạn có thể dễ dàng tùy biến để dùng:

Rich (BB code):
Sub SelectFilesInRange()
Dim Rg As Range, Cll As Range, MyPath As String, X
MyPath = ThisWorkbook.Path & "\"

On Error Resume Next
Set Rg = Application.InputBox("Quét 1 vùng", "Vùng quét", Type:=8)
If Err.Number = 424 Then
  MsgBox "Loi: chua chon vung!"
  Exit Sub
Else
   For Each Cll In Rg
       MsgBox MyPath & Cll.Value
   Next
End If
End Sub
Cảm ơn Banh, cái này thì OT biết nhưng OT muốn sử dụng cái kia để mở từng file rồi xử lý ạ.
 
Upvote 0
Upvote 0
trong vùng A1:A10 con đã nhập sẵn tên các file ví dụ: A1="A.xls";A2="B.xlsx",A3="B.xlsm"... đến A10.
Các tên file được liệt kê này để chung với thư mục cùng file chứa code này ạ.
Giờ con muốn đoạn code mà tương tự đoạn code con đưa lên nhưng nó không hiển thị cái cửa sổ để chọn file nữa (thay vì bước này nó chọn các file mà đã liệt kê trong vùng A1:A10 rồi
Đọc không tài nào hiểu nổi.
Mình quên cái mớ code kia đi. Mô tả cái yêu cầu, cái mình cần ấy.
 
Upvote 0
Mọi code bạn cũng từng biết, từng dùng
Mã:
Sub test()
Dim lastRow As Long, r As Long, filename()
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value    '  lấy dư 1 dòng cuoi
    End With
    For r = 1 To UBound(filename, 1) - 1    ' không xét dòng lấy dư
        If Not IsEmpty(filename(r, 1)) Then Debug.Print filename(r, 1)
    Next r
End Sub
Muốn đường dẫn đầy đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạn không biết Windows API.
Mã:
Sub test2()
Dim filename, fNames
    fNames = Application.GetOpenFilename("Excel Files (*.xlsx; *.xlsm; *.xlsb), *.xlsx; *.xlsm; *.xlsb", MultiSelect:=True)
    If IsArray(fNames) Then
        For Each filename In fNames
            Debug.Print filename
        Next filename
    End If
End Sub
 
Upvote 0
Đọc không tài nào hiểu nổi.
Mình quên cái mớ code kia đi. Mô tả cái yêu cầu, cái mình cần ấy.
Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.

OT.jpg
Bài đã được tự động gộp:

Mọi code bạn cũng từng biết, từng dùng
Mã:
Sub test()
Dim lastRow As Long, r As Long, filename()
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value    '  lấy dư 1 dòng cuoi
    End With
    For r = 1 To UBound(filename, 1) - 1    ' không xét dòng lấy dư
        If Not IsEmpty(filename(r, 1)) Then Debug.Print filename(r, 1)
    Next r
End Sub
Muốn đường dẫn đầy đủ thì If Not IsEmpty(filename(r, 1)) Then Debug.Print ThisWorkbook.Path & "\" & filename(r, 1)
-------------
Có thể dùng GetOpenFilename. Hoặc Windows API, nhưng bạn không biết Windows API.
Mã:
Sub test2()
Dim filename, fNames
    fNames = Application.GetOpenFilename("Excel Files (*.xlsx; *.xlsm; *.xlsb), *.xlsx; *.xlsm; *.xlsb", MultiSelect:=True)
    If IsArray(fNames) Then
        For Each filename In fNames
            Debug.Print filename
        Next filename
    End If
End Sub
Bác ơi, có lẽ là mô tả của con chưa rõ ràng nên Bác và Bạn @befaint mới chưa hiểu hết vấn đề con muốn ạ.
Với 'Application.FileDialog(msoFileDialogFilePicker)'
Có lẽ vấn đề con muốn là xử lý ở đoạn này để nó không xuất hiện cái cửa sổ để lựa chọn file Bác ạ:
Mã:
If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
           MsgBox "Selected item's path: " & vrtSelectedItem
        Next vrtSelectedItem
    Else
    End If
Nghĩa là với đoạn code trên có thể bỏ đi để thay bằng đoạn khác mà code tự lựa chọn luôn trong A1,A2,A3 được không Bác.
Hay là có thể dùng cách nào đó thay 'Application.FileDialog(msoFileDialogFilePicker)' ví dụ dùng 'CreateObject("Scripting.FileSystemObject")' ấy ạ
Hic hic con kém code nên giải thích về code cũng khiến mọi người khó hiểu,...
---
Hic không hiểu do diễn đàn hay do máy tính của con mà trình duyệt nó 'nhập nhoạng' loạn hết cả lên hic chic chỉ xem được có tý tẹo nội dung còn bị che hết một khoảng ở trên.

1610381527749.png
 

File đính kèm

  • OT.zip
    323.8 KB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
Dạ, OT xin gửi mô tả bằng hình ảnh để Bạn @befaint hiểu thêm ạ.
Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

1610384773108.png


Giờ lại kêu lấy danh sách điền vào cột A?

1610384739531.png

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.
 
Upvote 0
Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

View attachment 252828


Giờ lại kêu lấy danh sách điền vào cột A?

View attachment 252827

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.
Hic không phải là lấy sự lựa chọn để điền vào cột A đâu ạ, mà là cột A chưa là gì mà nó đã có sẵn rồi, giờ chỉ gọi nó lên để dùng để chiến luôn ấy ạ ahii.
Vâng đúng là khúc này mới chỉ dạo đầu thôi ạ, nó sẽ tìm trong cột A có bao nhiêu file trong cột A rồi mở lên làm gì gì đó rồi đóng lại bạn ạ.
Vâng đúng bạn phải kiểm tra danh sách có tồn tại hay không nếu có thì mở nó lên.
Và cái OT muốn hỏi có sử dụng với phương phâp dùng fileDialog... được không hay phải dùng cách khác ạ.
Hâyzzz hic chết mất thôi (OT đang tự trách mình Bạn ạ)
 
Upvote 0
Và cái OT muốn hỏi có sử dụng với phương phâp dùng fileDialog... được không
Không được. FileDialog dịch ra là cái hộp thoại chọn File thôi, chứ nó chẳng làm gì sứt.

PHP:
Public Function file_exists(ByVal file_path As String) As Boolean
    ' Rreturns True if file exists, else returns False

    If Len(file_path) = 0 Then file_exists = False: Exit Function
    Static FSo As Object
    If FSo Is Nothing Then Set FSo = CreateObject("Scripting.FileSystemObject")
    file_exists = FSo.FileExists(file_path)
End Function

Cách áp dụng:
PHP:
Sub vidu()
Dim curr_path as string, item as variant, file_path as string
curr_path = thisworkbook.path & "\"
For each item in Range("A1:A10").value2
file_path = curr_path & item
if file_exists(file_path)= true then
'chiến luôn
End if
Next item
End sub
 
Upvote 0
Sao cô cứ lộn tùng phèo vậy?

Lúc trước kêu có sẵn danh sách ở cột A rồi:

View attachment 252828


Giờ lại kêu lấy danh sách điền vào cột A?

View attachment 252827

Đã bảo là quên cái mớ code đó đi.
Kiểu kia thì cứ thế kiểm tra xem danh sách các files ở cột A có tồn tại hay không, nếu có thì chiến luôn thế thôi.

Mà túm lại nêu cái iêu cầu cuối cùng ấy. Chắc đoạn này mới là màn dạo đầu thôi chứ gì.
à trong hình ảnh OT gửi nói cái đoạn điền vào cột A đó là đã điền bằng tay trước khi chạy code rồi (nghĩa là nó có sẵn code không tự điền vào đây mà chỉ tìm trong này thôi) đúng như bạn hiểu lúc đầu, hic do OT mô tả sai, giờ bạn gửi lại mới để ý kỹ hơn.
Oài, thế nào OT cũng còn bị một trận mắng nữa của Bác ấy nữa hic ..
Thôi OT ngủ đây ạ, chúc mọi người ngủ ngon ạ.. hic hic
---
Bài đã được tự động gộp:

Không được. FileDialog dịch ra là cái hộp thoại chọn File thôi, chứ nó chẳng làm gì sứt.

PHP:
Public Function file_exists(ByVal file_path As String) As Boolean
    ' Rreturns True if file exists, else returns False

    If Len(file_path) = 0 Then file_exists = False: Exit Function
    Static FSo As Object
    If FSo Is Nothing Then Set FSo = CreateObject("Scripting.FileSystemObject")
    file_exists = FSo.FileExists(file_path)
End Function

Cách áp dụng:
PHP:
Sub vidu()
Dim curr_path as string, item as variant, file_path as string
curr_path = thisworkbook.path & "\"
For each item in Range("A1:A10").value2
file_path = curr_path & item
if file_exists(file_path)= true then
'chiến luôn
End if
Next item
End sub
Hic OT vừa gửi xong thì thấy bài này của Bạn, cảm ơn Bạn nhiều nhé, như vậy là OT cũng đã nghĩ đúng FileDialog là ko thể ẩn cửa sổ đi được OT tìm kiếm đoạn code nào cũng đề cập đến show (xuất hiện cái cửa sổ).. về code của Bạn, xin phép mai OT xem và ứng dụng thử nếu có vấn đề gì OT sẽ thông tin lại ạ.
Chúc Bạn ngủ ngon @befaint
 
Lần chỉnh sửa cuối:
Upvote 0
Bác ơi, có lẽ là mô tả của con chưa rõ ràng nên Bác và Bạn @befaint mới chưa hiểu hết vấn đề con muốn ạ.
Với 'Application.FileDialog(msoFileDialogFilePicker)'
Có lẽ vấn đề con muốn là xử lý ở đoạn này để nó không xuất hiện cái cửa sổ để lựa chọn file Bác ạ:
Mã:
If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
           MsgBox "Selected item's path: " & vrtSelectedItem
        Next vrtSelectedItem
    Else
    End If
Nghĩa là với đoạn code trên có thể bỏ đi để thay bằng đoạn khác mà code tự lựa chọn luôn trong A1,A2,A3 được không Bác.

mà là cột A chưa là gì mà nó đã có sẵn rồi, giờ chỉ gọi nó lên để dùng để chiến luôn ấy ạ
Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884
mở hay ghi tên file đã được lựa chọn đó ra cửa sổ Immediate

Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
Mã:
Sub test()
Dim lastRow As Long, r As Long, filename(), fso As Object
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")    ' (A)
    Application.ScreenUpdating = False
    For r = 1 To UBound(filename, 1) - 1
        If Not IsEmpty(filename(r, 1)) Then
            If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    Set fso = Nothing
End Sub

(A) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)
 
Upvote 0
. Tời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?
Con chào Bác ạ, vâng chính xác là con hỏi cái này ạ, con không muốn hiện cái lựa chọn ạ.
Dốt code nên giải thích cũng đến khổ mình và khổ cả người khác Bác nhỉ.
chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884
Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
Mã:
Sub test()
Dim lastRow As Long, r As Long, filename(), fso As Object
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")    ' (A)
    Application.ScreenUpdating = False
    For r = 1 To UBound(filename, 1) - 1
        If Not IsEmpty(filename(r, 1)) Then
            If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    Set fso = Nothing
End Sub
Đúng cái con cần rồi Bác, con cảm ơn Bác Siwtom, cảm ơn Bạn @befaint
 
Upvote 0
Tôi không hiểu bạn nói gì nữa. Theo bạn giải thích vòng vo thì bây giờ bạn muốn dùng FileDialog nhưng bỏ cửa số chọn tập tin và bỏ đoạn If .Show = -1 Then ... End If vì tên các tập tin lấy từ cột A. Trời ạ, FileDialog chỉ dùng với mục đích lấy tên các tập tin được chọn. Nếu không chọn nữa mà lấy các tên từ cột A thì đá đít thằng FileDialog chứ sao lại "dùng FileDialog nhưng bỏ If .Show = -1 Then ... End If"? Đã không phải chọn thì muôn đời không dùng FileDialog, bạn có hiểu điều đơn giản ấy không?

chiến luôn ở bài #2889 là hiển thị ở cửa sổ Immediate vì bạn viết ở bài #2884


Còn nếu muốn kiểm tra tồn tại rồi mở trong Excel thì
Mã:
Sub test()
Dim lastRow As Long, r As Long, filename(), fso As Object
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        filename = .Range("A1:A" & lastRow + 1).Value
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")    ' (A)
    Application.ScreenUpdating = False
    For r = 1 To UBound(filename, 1) - 1
        If Not IsEmpty(filename(r, 1)) Then
            If fso.FileExists(ThisWorkbook.Path & "\" & filename(r, 1)) Then Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    Set fso = Nothing
End Sub

(A) - tạo đối tượng fso lớp (class) FileSystemObject để sau đó dùng phương thức FileExists của nó kiểm tra sự tồn tại của tập tin bất kỳ (không chỉ tập tin Excel - tập tin bất kỳ)
Bác ơi , con hỏi thêm với ạ câu lệnh sau:
Workbooks.Open ThisWorkbook.Path & "\" & filename(r, 1)
Mở được các tập tin "*.xls*", nhưng với file PDF thì không, vậy với file PDF thì cú pháp mở file PDF với fso thì như thế nào ạ ?
 
Upvote 0
Mở mọi tập tin theo ứng dụng đã cài đặt mặc định.

PHP:
Call Shell(file_path, vbNormalFocus)
OT đang tách một phần câu lệnh trên để chuyển thành hàm, ví dụ:
Mã:
Function OpnFile(filename As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not IsEmpty(filename) Then
        If fso.fileExists(filename) Then
            If filename Like "*.xls*" Then
                Workbooks.Open filename
            ElseIf filename Like "*.pdf" Then
                Call Shell(filename, vbNormalFocus)
            End If
        End If
    End If
    Set fso = Nothing
End Function
Không biết như vậy có đúng không Bạn @befaint ?
 
Lần chỉnh sửa cuối:
Upvote 0
OT đang tách một phần câu lệnh trên để chuyển thành hàm, ví dụ:
Mã:
Function OpnFile(filename As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not IsEmpty(filename) Then
        If fso.fileExists(filename) Then
            If filename Like "*.xls*" Then
                Workbooks.Open filename
            ElseIf filename Like "*.pdf" Then
                Call Shell(filename, vbNormalFocus)
            End If
        End If
    End If
    Set fso = Nothing
End Function
Không biết như vậy có đúng không Bạn @befaint ?
A! được rồi , OT làm được rồi ahihi:yahoo:
Mã:
Option Explicit

Function OpenOtherFile(sFile As String)
    Dim sApp As Object
    Set sApp = CreateObject("Shell.Application")
    sApp.Open (sFile)
End Function

Function OpnFile(filename As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not IsEmpty(filename) Then
        If fso.fileExists(filename) Then
            If filename Like "*.xls*" Then
                Workbooks.Open filename
            ElseIf filename Like "*.pdf" Then
                OpenOtherFile filename
            End If
        End If
    End If
    Set fso = Nothing
End Function

Sub test()
    Dim r As Long, afile As Variant, fName As String, Wb As Workbook
    On Error GoTo Err_
    Application.ScreenUpdating = True
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Sheet1")
        r = .Cells(Rows.Count, "A").End(xlUp).Row
        afile = .Range("A1:A" & r + 1).Value
    End With
    For r = 1 To UBound(afile, 1) - 1
        fName = Wb.Path & "\" & afile(r, 1)
        OpnFile fName
    Next r
Err_:
    Application.ScreenUpdating = False
    If Err.Number <> 0 Then MsgBox "Error :" & Err.Description, vbCritical, Err.Number
End Sub
 
Upvote 0
Function OpenOtherFile(sFile As String)
Dim sApp As Object
Set sApp = CreateObject("Shell.Application")
sApp.Open (sFile)
End Function
Không cần phải dựng object đó. Dùng luôn lệnh Shell là được rồi.

Function OpnFile(filename As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not IsEmpty(filename) Then
If fso.fileExists(filename) Then
If filename Like "*.xls*" Then
Workbooks.Open filename
ElseIf filename Like "*.pdf" Then
OpenOtherFile filename
End If
End If
End If
Set fso = Nothing
End Function
Lấy cái hàm làm cho ấy.
Khai báo thế kia mỗi lần dùng tới phải dựng lại cái fso mệt.

---
PHP:
Function OpnFile(byval filename As String)
    Const excelExt = "XLS"  '*.xls*
    Const pdfExt = "PDF"  '*.pdf*
    Static fso As Object
    Dim fileExt as string
    If fso is nothing then Set fso = CreateObject("Scripting.FileSystemObject")
    fileExt =  vba.ucase$(fso.GetExtensionName(filename))
    If len(filename) > 0 Then
        If fso.fileExists(filename) Then
            If instr(fileExt, excelExt, vbBinaryCompare) > 0  Then
                Workbooks.Open filename
            ElseIf pdfExt  = fileExt Then
                Call Shell(filename, vbNormalFocus)
            End If
        End If
    End If
    Set fso = Nothing
End Function
 
Upvote 0
Xin chào các bạn,
Khi OT muốn copy 1 dòng được lựa chọn, OT làm như sau:
Mã:
Sub ThemDong()
    Dim i As Integer
    i = Selection.Row
    Rows(i & ":" & i).Copy
    Rows(i & ":" & i).Insert Shift:=xlUp
End Sub

Nhưng khi OT muốn copy những dòng được lựa chọn thì OT viết như sau:
Mã:
Sub ThemDong()
    Dim i As Integer, r As Range
    For Each r In Selection
        i = r.Row
        Rows(i & ":" & i).Copy
        Rows(i & ":" & i).Insert Shift:=xlUp
    Next r
End Sub

Nếu chọn xen kẽ các ô thì không sao (A1,A3,A10,...), còn khi chọn liền nhau(A1,A3:A5) thì code nó lặp không nghỉ ạ.
Nhờ các bạn xử giúp vòng lặp ạ hic,
 
Upvote 0
Web KT
Back
Top Bottom