giúp em tạo mục lục với

Liên hệ QC

ltrunghieu

Thành viên mới
Tham gia
23/12/09
Bài viết
17
Được thích
1
Em lên diễn đàn thấy code tạo mục lục như sau:
PHP:
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim lCount As Long
lCount = 1

With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
lCount = lCount + 1
With wSheet
.Range("A1").Name = "Start" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", SubAddress:= _
"Index", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(lCount, 1), Address:="", SubAddress:= _
"Start" & wSheet.Index, TextToDisplay:=wSheet.Name
End If 
Next wSheet
End Sub

Nhưng khỗ nỗi khi áp dụng vào file của em có vấn đề như sau:
- Ở ô A1 của mỗi sheet có từ " Back to Index" nhưng bấm vào không quay trở lại sheet Index
- Trong các sheet của em tại Ô A1 đều có dữ chữ vậy mà chữ" Back to Index" cứ nằm đè lên làm khi in cứ bị dính nó hoài.
- Em muốn mấy anh giúp em sửa code trên như thê nào để bấm vào back to Index thì quay về sheet Index và em không muốn in chữ Back to Index ra ( In ra có làm gì đâu ). Nếu được thì hay quá!! Nếu không được mấy anh bỏ luôn chữ đó ra dùm em thì em cũng cám ơn nhiều lắm rồi
 
Chỉnh sửa lần cuối bởi điều hành viên:
Bạn nhấp chuột phải là link để sửa lại đường link về sheet index
Còn không muốn in thì bạn chọn vùng in chừa dòng đó ra hoặc cho chữ mầu trắng là xong.
 
Upvote 0
Bạn dùng code sau:

Mã:
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim M As Long
M = 1
    With Me
       .Columns(1).ClearContents
       .Cells(1, 1) = "DANH SACH TEN SHEET"
       .Cells(1, 1).Name = "Index"
    End With
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
        M = M + 1
        With wSheet
            .Range("a1").Name = "Start" & wSheet.Index
            .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
            SubAddress:="Index", TextToDisplay:="TRO VE TRANG CHINH"
        End With
            Me.Hyperlinks.Add Anchor:=Me.Cells(M, 1), Address:="", _
            SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
        End If
    Next wSheet
End Sub
Ban xem them file nhe.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Trước là cám ơn mấy bác đã giúp đỡ tận tình, sau là nhờ thêm cái nữa. Hii như em nói em không muốn in chữ Back to Index hay TRỞ VẾ TRANG CHINH đâu vì đâu cần thiết đâu, có code không cho in chữ đó ra luôn không vậy thì tốt quá, chừa vùng đó ra hoặc chữ màu tráng thì không ổn rồi vì ô A1 em đang có dữ liệu mà nó cứ nằm đè lên mà để ở ô khác thì không tiện cho lắm, tức là em có file, sheet nào cũng vậy ô A1 có chữ hết rồi, bây giờ muốn thêm cái mục lục cho tiện thôi. Nói như thế cho pác rõ xem giúp được thêm không?
 
Upvote 0
Trước là cám ơn mấy bác đã giúp đỡ tận tình, sau là nhờ thêm cái nữa. Hii như em nói em không muốn in chữ Back to Index hay TRỞ VẾ TRANG CHINH đâu vì đâu cần thiết đâu, có code không cho in chữ đó ra luôn không vậy thì tốt quá, chừa vùng đó ra hoặc chữ màu tráng thì không ổn rồi vì ô A1 em đang có dữ liệu mà nó cứ nằm đè lên mà để ở ô khác thì không tiện cho lắm, tức là em có file, sheet nào cũng vậy ô A1 có chữ hết rồi, bây giờ muốn thêm cái mục lục cho tiện thôi. Nói như thế cho pác rõ xem giúp được thêm không?

Dựa theo Code của bạn Domfootwear, Bạn thêm vào một chút thôi nhé: Code tại sheet INDEX: Bạn thêm dòng này vào:
.Range("a1").Value = "TRO VE TRANG CHINH"
Mã:
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim M As Long
M = 1
    With Me
       .Columns(1).ClearContents
       .Cells(1, 1).Value = "DANH SACH TEN SHEET"
       .Cells(1, 1).Name = "Index"
    End With
    For Each wSheet In Worksheets
 
        If wSheet.Name <> Me.Name Then
        M = M + 1
        With wSheet
            [B][COLOR=red].Range("a1").Value = "TRO VE TRANG CHINH"[/COLOR][/B]
            .Range("a1").Name = "Start" & wSheet.Index
            .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
            SubAddress:="Index", TextToDisplay:="TRO VE TRANG CHINH"
        End With
            Me.Hyperlinks.Add Anchor:=Me.Cells(M, 1), Address:="", _
            SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
        End If
    Next wSheet
End Sub

Code tại ThisWorkbook bạn viết code này:
Mã:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
  ActiveSheet.Range("A1") = ""
End Sub

Chúc vui!
 
Lần chỉnh sửa cuối:
Upvote 0
Hay thì hay thật nhưng code này nó làm mất luôn dữ liệu ở ô A1 của em rồi, Ô A1 của em có chữ Cộng Hoà Xã Hội Chủ Nghĩa, ô a2 có Độc Lập Tự Do Hạnh Phúc, vào print preview chỉ còn chữ ô a2 Độc Lập Tự Do Hạnh Phúc thôi mất chữ ở ô A1 rồi. Hic Hic với lại em có tất cả 52 sheet có những sheet rất hay dùng đến có sheet cả năm đụng tới 1 lần vậy mà sheet Index nó dài cả thước làm kéo xuống nhiều khi còn lâu hơn hihi anh sẵn giúp em làm thành 3 cột cho ngắn được không? hay dùng, ít dùng, sẽ dùng. Vậy thì tuyệt cú mèo, em kiếm chỗ đưa file lên mà sao kiếm hoài không thấy, thôi mấy bác tưởng tượng dùm em nhé, chưa vui được nhưng cũng thank pac nha
 
Upvote 0
Ah, em biết làm sao rồi, ở mỗi sheet em insert thêm 1 dòng rồi thu nhỏ nó lại, hoặc là ínert dòng xong hide nó đi thế là xong nhưng hình như thủ công nhỉ có cách nào khoẻ hơn tý không anh?
 
Upvote 0
Đang nằm thấy 1 ý tưởng lên viết luôn mắc công mai quên. Vậy chúng ta sẽ thêm 1 đoạn code để khi chạy code thì sẽ tự động thêm 1 dòng ở mỗi sheet trước khi tạo thành mục lục hoặc là tự động thêm 1 dòng ở mỗi sheet xong hide nó đi rồi sau đó tạo mục lục ( nếu ai đó không muốn thấy luôn chữ back to Index ). Haha mình thấy mình cũng thông minh đấy nhi? Hehe còn code sẽ như thế nào thì nhờ mấy pac1 viết hộ em cái, em chưa thông minh đến như vậy. Hehe
 
Upvote 0
Đang nằm thấy 1 ý tưởng lên viết luôn mắc công mai quên. Vậy chúng ta sẽ thêm 1 đoạn code để khi chạy code thì sẽ tự động thêm 1 dòng ở mỗi sheet trước khi tạo thành mục lục hoặc là tự động thêm 1 dòng ở mỗi sheet xong hide nó đi rồi sau đó tạo mục lục ( nếu ai đó không muốn thấy luôn chữ back to Index ). Haha mình thấy mình cũng thông minh đấy nhi? Hehe còn code sẽ như thế nào thì nhờ mấy pac1 viết hộ em cái, em chưa thông minh đến như vậy. Hehe
Không cần phải như thế đâu bạn, ví dụ bây giờ các sheet khác cell A1 và A2 bạn có dữ liệu thì mình dời chữ "TRỞ VỀ TRANG CHÍNH" sang 1 cell nào đó mà sheet của bạn chưa có dữ liệu
 
Upvote 0
Cám ơn đã trả lời em, nhưng nếu như thế thì chưa ổn bác ah? Vì mình có khoảng 50 sheet đi, đâu phải sheet nào cũng giống nhau đâu, phom này khác phom kia nên thừơng thì sheet này có dữ liệu tại ô này nhưng sheet khác lại nằm ở ô khác vậy thì làm sao?? Nếu để xa quá vd A1000 thì chắc chắn là khôg sheet nào có rồi nhưng như thế thì hơi lâu bác nhỉ?? Xin giúp em với
 
Upvote 0
Cám ơn đã trả lời em, nhưng nếu như thế thì chưa ổn bác ah? Vì mình có khoảng 50 sheet đi, đâu phải sheet nào cũng giống nhau đâu, phom này khác phom kia nên thừơng thì sheet này có dữ liệu tại ô này nhưng sheet khác lại nằm ở ô khác vậy thì làm sao?? Nếu để xa quá vd A1000 thì chắc chắn là khôg sheet nào có rồi nhưng như thế thì hơi lâu bác nhỉ?? Xin giúp em với
Bạn nói vậy sao được! Dữ liệu của bạn thì bạn phải quản lý cho trật tự chứ
Lý nào không thể chừa ra được 1 cell rổng giống nhau cho tất cả các sheet?
Nếu khó khăn quá thì khỏi xài vậy ---> Click phải vào sheet tab rồi chọn tên sheet để đi đến sheet mình cần, khỏi code!
 
Upvote 0
Hii thấy có vẻ giận em ah? Tức là từ trước giờ đâu co biết mấy cái nay đâu anh, mới lên mạng thấy hay quá định áp dụng vào file của minh nhưng nó nằm tùm lum từ trước rồi, thì em cũng đã nói trước rối mà, nếu em thêm 1 dòng ở tất cảc các sheet rồi chạy code thì đâu có sao? thấy thủ công quá nên em xin mấy anh code sao mà trước là thêm dòng ở mỗi sheet trước sau đó mới tạo mục lục mà về khoản VBA thì em ngu quá nên nhờ mấy anh viết hộ. cám ơn mấy anh nhé!! àh còn cái khoản mà nhiều sheet hay dùng, ít dùng và lâu lâu mới dùng mây anh giúp hộ em được không vậy? chứ để 1 hàng thì nó dài quá anh ơi! thank nhe anh, đừng giận nữa ma
 
Upvote 0
Hii thấy có vẻ giận em ah? Tức là từ trước giờ đâu co biết mấy cái nay đâu anh, mới lên mạng thấy hay quá định áp dụng vào file của minh nhưng nó nằm tùm lum từ trước rồi, thì em cũng đã nói trước rối mà, nếu em thêm 1 dòng ở tất cảc các sheet rồi chạy code thì đâu có sao? thấy thủ công quá nên em xin mấy anh code sao mà trước là thêm dòng ở mỗi sheet trước sau đó mới tạo mục lục mà về khoản VBA thì em ngu quá nên nhờ mấy anh viết hộ. cám ơn mấy anh nhé!! àh còn cái khoản mà nhiều sheet hay dùng, ít dùng và lâu lâu mới dùng mây anh giúp hộ em được không vậy? chứ để 1 hàng thì nó dài quá anh ơi! thank nhe anh, đừng giận nữa ma

Bạn theo đường link này nhé, bài viết của Thầy Tedaynui, rất hay. Thay vì bạn đặt là Quay Về, thì bài này dùng Index trong 1 object. Đặc điểm của Object nếu bạn không muốn in nó ra, bạn chỉ cần bỏ chọn Print thôi là xong. Khuyết điểm của nó nếu sheet nhiều sheet mà sheet nào cũng có object thì dung lượng lại tăng nhiều. Tuy nhiên bạn thử dùng nhiều phương pháp nhé!
http://www.giaiphapexcel.com/forum/showpost.php?p=55892&postcount=14
 
Upvote 0
Chuyện đơn giản thôi mà. Trong tất cả các đoạn code ở trên cái nào xài ngon nhất thì xài, sửa chút đỉnh:

- Cách 1: Muốn insert 1 dòng trước khi tạo chỉ mục:

Thêm 1 dòng lệnh ngay dưới câu lệnh With wSheet:
PHP:
 .[a1].EntireRow.Insert
Sau đó format chữ trắng để khỏi in ra.

Cách 2: Không chèn dòng và giữ nguyên giá trị ô A1:

Thay TextToDisplay:="Index" hoặc TextToDisplay:="Tro ve trang chinh"
bằng:
PHP:
TextToDisplay:=.[A1].text

Ai cũng loay hoay đi tìm ở đâu đâu ấy!
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom