Tạo danh mục bị lỗi reference is not valid

bjboyn00b · 25/5/16

Mình có lấy code ở trên mạng để tạo list các sheet trong file ở sheet đầu tiên, với vài sheet không sao, nhưng với file có nhiều sheet thì bị lỗi "reference is not valid"
Code mình lấy như sau:

Mã:

Sub Binh_Creat_List()
'
' Binh_Creat_List Macro
'
' Keyboard Shortcut: Ctrl+j

Dim wsSheet As Worksheet
Dim ws As Worksheet
Dim Counter As Long
On Error Resume Next
Set wsSheet = Sheets("Mucluc")
'Kiem tra su ton tai cua Sheet
On Error GoTo 0
If wsSheet Is Nothing Then
'Neu chua co thi them vao vi tri dau tien cua Workbook
Set wsSheet = ActiveWorkbook.Sheets.Add(Before:=Worksheets(1))
wsSheet.Name = "Mucluc"
End If
With wsSheet
.Cells(2, 1) = "DANH SACH CAC SHEET"
.Cells(2, 1).Name = "Index"
.Cells(4, 1).Value = "STT"
.Cells(4, 2).Value = "Ten Sheet"
End With
'Merge Cell
With Range("A2:B2")
.Merge
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
'Set ColumnWidth
With Columns("A:A")
.ColumnWidth = 8
.HorizontalAlignment = xlCenter
End With
With Range("A4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Columns("B:B").ColumnWidth = 30
With Range("B4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Counter = 1
For Each ws In Worksheets
If ws.Name <> wsSheet.Name Then
'Gan gia tri cot thu tu
wsSheet.Cells(Counter + 4, 1).Value = Counter
'Tao lien ket
wsSheet.Hyperlinks.Add Anchor:=wsSheet.Cells(Counter + 4, 2), _
Address:="", _
SubAddress:=ws.Name & "!A1", _
ScreenTip:=ws.Name, _
TextToDisplay:=ws.Name
'Them nut Quay ve Sheet Muc luc tai moi Sheet
With ws
.Hyperlinks.Add Anchor:=.Range("H1"), Address:="", SubAddress:="Index", TextToDisplay:="Quay ve"
End With
Counter = Counter + 1
End If
Next ws
Set xlSheet = Nothing
End Sub

Ai biết chỉ giúp mình code sai ở đâu với nhé

giaiphap · 25/5/16

Bạn up file bị lỗi lên xem thử thế nào, chứ nhìn vào đám rừng này mệt quá.

bjboyn00b · 25/5/16

giaiphap đã viết:
Bạn up file bị lỗi lên xem thử thế nào, chứ nhìn vào đám rừng này mệt quá.

File kiểu này nhé bạn

quanluu · 25/5/16

bjboyn00b đã viết:
File kiểu này nhé bạn

với tên sheets có dấu "-" thì phải có nháy cho tên sheets nhé: 'xxx'

SubAddress:="'" & ws.Name & "'!A1",_

bjboyn00b · 26/5/16

quanluu1989 đã viết:
với tên sheets có dấu "-" thì phải có nháy cho tên sheets nhé: 'xxx'

SubAddress:="'" & ws.Name & "'!A1",_

Cảm ơn bạn, mình sửa rồi nhưng vẫn bị, không phải chỉ sheet có dấu - mới bị mà sheet thường cũng thế, có sheet được, có sheet không

giaiphap · 26/5/16

bjboyn00b đã viết:
Cảm ơn bạn, mình sửa rồi nhưng vẫn bị, không phải chỉ sheet có dấu - mới bị mà sheet thường cũng thế, có sheet được, có sheet không

Miễn tên sheet có dấu "-", khoảng trắng, dấu "="... và một số ký tự đặc biệt khác đều bị.

bjboyn00b · 26/5/16

giaiphap đã viết:
Miễn tên sheet có dấu "-", khoảng trắng, dấu "="... và một số ký tự đặc biệt khác đều bị.

Mình đã sửa như sau

Mã:

Sub Binh_Creat_List()
'
' Binh_Creat_List Macro
'
' Keyboard Shortcut: Ctrl+j

Dim wsSheet As Worksheet
Dim ws As Worksheet
Dim Counter As Long
On Error Resume Next
Set wsSheet = Sheets("Mucluc")
'Kiem tra su ton tai cua Sheet
On Error GoTo 0
If wsSheet Is Nothing Then
'Neu chua co thi them vao vi tri dau tien cua Workbook
Set wsSheet = ActiveWorkbook.Sheets.Add(Before:=Worksheets(1))
wsSheet.Name = "Mucluc"
End If
With wsSheet
.Cells(2, 1) = "DANH SACH CAC SHEET"
.Cells(2, 1).Name = "Index"
.Cells(4, 1).Value = "STT"
.Cells(4, 2).Value = "Ten Sheet"
End With
'Merge Cell
With Range("A2:B2")
.Merge
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
'Set ColumnWidth
With Columns("A:A")
.ColumnWidth = 8
.HorizontalAlignment = xlCenter
End With
With Range("A4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Columns("B:B").ColumnWidth = 30
With Range("B4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Counter = 1
For Each ws In Worksheets
If ws.Name <> wsSheet.Name Then
'Gan gia tri cot thu tu
wsSheet.Cells(Counter + 4, 1).Value = Counter
'Tao lien ket
wsSheet.Hyperlinks.Add Anchor:=wsSheet.Cells(Counter + 4, 2), _
Address:="", _
[COLOR=#ff0000]SubAddress:="'" & ws.Name & "'!A1",_[/COLOR]
ScreenTip:=ws.Name, _
TextToDisplay:=ws.Name
'Them nut Quay ve Sheet Muc luc tai moi Sheet
With ws
.Hyperlinks.Add Anchor:=.Range("H1"), Address:="", SubAddress:="Index", TextToDisplay:="Quay ve"
End With
Counter = Counter + 1
End If
Next ws
Set xlSheet = Nothing
End Sub

Sửa như vậy đã okie chưa bạn nhỉ?

quanluu · 26/5/16

bjboyn00b đã viết:

Mình đã sửa như sau

Mã:

Sub Binh_Creat_List()
'
' Binh_Creat_List Macro
'
' Keyboard Shortcut: Ctrl+j

Dim wsSheet As Worksheet
Dim ws As Worksheet
Dim Counter As Long
On Error Resume Next
Set wsSheet = Sheets("Mucluc")
'Kiem tra su ton tai cua Sheet
On Error GoTo 0
If wsSheet Is Nothing Then
'Neu chua co thi them vao vi tri dau tien cua Workbook
Set wsSheet = ActiveWorkbook.Sheets.Add(Before:=Worksheets(1))
wsSheet.Name = "Mucluc"
End If
With wsSheet
.Cells(2, 1) = "DANH SACH CAC SHEET"
.Cells(2, 1).Name = "Index"
.Cells(4, 1).Value = "STT"
.Cells(4, 2).Value = "Ten Sheet"
End With
'Merge Cell
With Range("A2:B2")
.Merge
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
'Set ColumnWidth
With Columns("A:A")
.ColumnWidth = 8
.HorizontalAlignment = xlCenter
End With
With Range("A4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Columns("B:B").ColumnWidth = 30
With Range("B4")
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
Counter = 1
For Each ws In Worksheets
If ws.Name <> wsSheet.Name Then
'Gan gia tri cot thu tu
wsSheet.Cells(Counter + 4, 1).Value = Counter
'Tao lien ket
wsSheet.Hyperlinks.Add Anchor:=wsSheet.Cells(Counter + 4, 2), _
Address:="", _
[COLOR=#ff0000]SubAddress:="'" & ws.Name & "'!A1",_[/COLOR]
ScreenTip:=ws.Name, _
TextToDisplay:=ws.Name
'Them nut Quay ve Sheet Muc luc tai moi Sheet
With ws
.Hyperlinks.Add Anchor:=.Range("H1"), Address:="", SubAddress:="Index", TextToDisplay:="Quay ve"
End With
Counter = Counter + 1
End If
Next ws
Set xlSheet = Nothing
End Sub

Sửa như vậy đã okie chưa bạn nhỉ?

cái chỗ bôi đỏ giống như mình nói mà. Mình test có bị cái nào đâu nhỉ?

bjboyn00b · 26/5/16

quanluu1989 đã viết:
cái chỗ bôi đỏ giống như mình nói mà. Mình test có bị cái nào đâu nhỉ?

mình làm thì bị báo như sau

Bạn xem giúp mình nhé, tk bạn

bjboyn00b · 26/5/16

a .

bjboyn00b · 26/5/16

quanluu1989 đã viết:
cái chỗ bôi đỏ giống như mình nói mà. Mình test có bị cái nào đâu nhỉ?

Hehe, thank bạn, mình vừa tự mò ra được rồi, đúng ra là thêm nháy cả sau nữa

Mã:

[COLOR=#ff0000]SubAddress:="'" & ws.Name & "'" & "'!A1",_

[/COLOR]

quanluu · 26/5/16

bjboyn00b đã viết:
mình làm thì bị báo như sau

Bạn xem giúp mình nhé, tk bạn

Ảnh của bạn mờ quá, chẳng nhìn thấy gì, theo mình suy đoán bạn bị lỗi ở sheet có STT 16, 17. và mình thử test với file, có vấn đề gì đâu.

Ba Tê · 26/5/16

bjboyn00b đã viết:
mình làm thì bị báo như sau

Bạn xem giúp mình nhé, tk bạn

Nếu file của bạn đã có sẵn sheet "Mucluc" thì chạy thử Sub này coi sao:

PHP:

Public Sub GPE()
Application.ScreenUpdating = False
Dim Ws As Worksheet, Rng As Range, Cll As Range, Tem As String, Arr(), K As Long
ReDim Arr(1 To Worksheets.Count, 1 To 1)
For Each Ws In Worksheets
    If Ws.Name <> "Mucluc" Then
        Tem = Ws.Name
        K = K + 1
        Arr(K, 1) = Tem
        Ws.Activate
        ActiveSheet.Hyperlinks.Add Anchor:=Range("H1"), Address:="", SubAddress:= _
        "'Mucluc'!H1", TextToDisplay:="Quay Ve"
    End If
Next Ws
With Sheets("Mucluc")
    .Activate
    .[B5:B1000].Clear
    .Range("B5:B1000").NumberFormat = "@"
    .[B5].Resize(K) = Arr
    Set Rng = .Range(.[B5], .[B5].End(xlDown))
    Rng.Sort Key1:=.[B5]
    For Each Cll In Rng
        ActiveSheet.Hyperlinks.Add Anchor:=Cll, Address:="", SubAddress:= _
        "'" & Cll.Value & "'!H1", TextToDisplay:=Cll.Value
    Next Cll
End With
End Sub

thanhtungk31 · 7/3/19

Ba Tê đã viết:

Nếu file của bạn đã có sẵn sheet "Mucluc" thì chạy thử Sub này coi sao:

PHP:

Public Sub GPE()
Application.ScreenUpdating = False
Dim Ws As Worksheet, Rng As Range, Cll As Range, Tem As String, Arr(), K As Long
ReDim Arr(1 To Worksheets.Count, 1 To 1)
For Each Ws In Worksheets
    If Ws.Name <> "Mucluc" Then
        Tem = Ws.Name
        K = K + 1
        Arr(K, 1) = Tem
        Ws.Activate
        ActiveSheet.Hyperlinks.Add Anchor:=Range("H1"), Address:="", SubAddress:= _
        "'Mucluc'!H1", TextToDisplay:="Quay Ve"
    End If
Next Ws
With Sheets("Mucluc")
    .Activate
    .[B5:B1000].Clear
    .Range("B5:B1000").NumberFormat = "@"
    .[B5].Resize(K) = Arr
    Set Rng = .Range(.[B5], .[B5].End(xlDown))
    Rng.Sort Key1:=.[B5]
    For Each Cll In Rng
        ActiveSheet.Hyperlinks.Add Anchor:=Cll, Address:="", SubAddress:= _
        "'" & Cll.Value & "'!H1", TextToDisplay:=Cll.Value
    Next Cll
End With
End Sub

--------------------------------------------------------------

Mình làm cách này được nha. Cám ơn bạn.

Tạo danh mục bị lỗi reference is not valid

bjboyn00b

Thành viên chính thức

giaiphap

==(^o^)==

bjboyn00b

Thành viên chính thức

File đính kèm

quanluu

Thành viên gắn bó

bjboyn00b

Thành viên chính thức

giaiphap

==(^o^)==

bjboyn00b

Thành viên chính thức

quanluu

Thành viên gắn bó

bjboyn00b

Thành viên chính thức

File đính kèm

bjboyn00b

Thành viên chính thức

File đính kèm

bjboyn00b

Thành viên chính thức

quanluu

Thành viên gắn bó

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

thanhtungk31

Thành viên mới

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng