Cách xóa đoạn code cũ, thay thế bằng 1 đoạn code mới mà không mở file.

Xin các anh chị vui lòng hướng dẫn em Cách xóa đoạn code cũ, thay thế bằng 1 đoạn code mới mà không mở file (Có Pass ở VBA).

Do em có nhiều file Excel có code, bây giờ muốn cập nhật code mới nhưng mở từ file, mở từng pass (Có 1 pass duy nhất) rồi xóa code cũ, thay thế code cũ = code mới.

Em xin cám ơn trước.

Làm việc này mà không cần mở file thì tôi chẳng biết dùng cách gì. Tuy nhiên cũng có vài gợi ý:
– Mở từng Workbook
– Active Workbook vừa mở
– Xóa Module cũ
– Chèn Module mới
———————
Việc xóa Module, trên GPE đã có nói rồi… Tôi chỉ xin góp giải pháp chèn module
– Giả sử bạn có đoạn code:

Sub ThiNghiem()
MsgBox "Hello"
End Sub
– Hãy cho code này vào 1 file TXT (ví dụ code cho vào file Test.txt nằm tại ổ D)
– Active Workbook mà bạn cần chèn code rồi chạy sub dưới đây:

Sub ImportModule()
ExecuteExcel4Macro ("VBA.INSERT.FILE(""D:Test.txt"")")
End Sub
Đây là hàm Macro 4 khá hay, tôi đã từng gữi vào mục đố vui nhưng chẳng thấy ai trả lời! Nhân tiện bạn hỏi nên gữi cho bạn tham khảo
– Code dùng hàm Macro 4 này còn có 1 độc chiêu, đó là cho dù file của anh có pass bảo vệ VBA thì nó vẫn insert code được như thường —> Thế mới siêu!

Em đang "Vật lộn" với cái đường dẫn chết tuyệt của cái file text đó, làm sao cho nó linh hoạt hơn, mong Thầy chỉ tiếp giúp.

Cái này thì mình vẫn làm, làm bằng tay, phải mở Pass, rất mất thời gian.
Còn nếu như dùng code thì file nào có Pass VBA thì thua, nó không cho chèn code vào.

Là sao ta? Tôi chưa hiểu lắm! Nói rõ chút đi (về cái vụ LINH HOẠT ấy)
Hay là bạn muốn đặt biến cho đường dẩn này… kiểu:

Sub ImportModule()
Dim Txtfile As String
Txtfile = "gì gì đó"
ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & Txtfile & """)")
End Sub

Là em đang tìm cách thay thế đường dẫn dẩn đến file text bằng Dialog, nhưng chưa được.

Sao lại không được nhỉ?

Sub ImportModule()
Dim Txtfile As String
With Application.FileDialog(3)
.Show: .AllowMultiSelect = False
Txtfile = .SelectedItems(1)
End With
ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & Txtfile & """)")
End Sub

Vấn đề nằm ở chổ là mấy cái dấu """, em chưa hiểu chổ đó, thường thì Text nằm trong "" trong trường hợp này nó "vật" em hôm qua đến nay.

Cách đơn giản nhất là THÍ NGHIỆM
Tôi sẽ làm thế này:

Sub Test()
Dim Txtfile As String
Txtfile = "D:Test.xls"
MsgBox "VBA.INSERT.FILE(" & Txtfile & ")"
End Sub
Kết quả của MsgBox là VBA.INSERT.FILE(D:Test.xls)
Thử thêm 1 dấu nháy đôi vào 2 đâu

Sub Test()
Dim Txtfile As String
Txtfile = "D:Test.xls"
MsgBox "VBA.INSERT.FILE("" & Txtfile & "")"
End Sub
Ta có kết quả MsgBox là VBA.INSERT.FILE(" & Txtfile & ")
Thêm tiếp 1 dấu nháy nữa

Sub Test()
Dim Txtfile As String
Txtfile = "D:Test.xls"
MsgBox "VBA.INSERT.FILE(""" & Txtfile & """)"
End Sub
Kết quả là: VBA.INSERT.FILE("D:Test.xls")
Đúng như mong đợi

Đúng là khi ra kết quả mới thấy nó đơn giản.
Hôm qua đến giờ em chỉ đến trường hợp 1+2

xin hỏi thày NDU nếu ta copy code vào Thisworkbook thì code trên sửa thế thế nào ạ ?

Cái thằng Macro 4 ấy chỉ chèn code vào Module thôi bạn à. Muốn chèn vào Sheet hoặc Workbook thì dùng cách khác
————-
Dù gì bạn cứ thử cho tôi đoạn code Thisworkbook tôi xem thế nào rồi mới tính được chứ

"Hà nội đêm trở gió", nó không chỉ trở gió mà "chở" cả "sét" lằng nhằng nên nhà em sợ tắt máy không dám ngồi , và lại thấy khuya tưởng thày cũng nghỉ nên không vào mạng nữa . Xin lỗi thày ! Code đi kèm thì nó chạy rồi nhưng riêng code trong thisworkbook nó không tự động cập nhật được nên mỗi lần muốn chạy nó cứ phải mở toang ra rồi copy dán vào nó mới chạy . Sợ các thày nghĩ "không chịu lao động" chỉ "há miệng chờ sung" nên nhà em chỉ hỏi phần còn vướng . Thầy nói vậy thì nhà em gửi cả file để thày giúp cho hoàn chỉnh hơn .

Hơi khó hiểu chút
Tôi nghĩ trường hợp như bạn chỉ cần chạy code này là được rồi:

Sub Auto_Open()
  On Error Resume Next
  With ThisWorkbook.VBProject
    With .VBComponents("ThisWorkbook")
      .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
      .CodeModule.InsertLines 1, _
      "Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)" & vbLf & _
      "  Application.ScreenUpdating = False" & vbLf & _
      "  On Error Resume Next" & vbLf & _
      "  Dim cond As FormatCondition" & vbLf & _
      "  If Target.Cells(1, 1).FormatConditions.Count > 0 Then" & vbLf & _
      "    Set cond = Target.Cells(1, 1).FormatConditions(1)" & vbLf & _
      "    If cond.Formula1 = ""=ROW()=CELL(""""ROW"""")"" Then" & vbLf & _
      "      Target.Calculate" & vbLf & _
      "    End If" & vbLf & _
      "    Set cond = Nothing" & vbLf & _
      "  End If" & vbLf & _
      "  Application.ScreenUpdating = True" & vbLf & _
      "End Sub"
    End With
  End With
End Sub

Thậm chí cũng chả cần chạy vì Sub Auto_Open sẽ tự chạy khi bạn khởi động file và nó sẽ tự chèn code vào Thisworkbook theo ý của bạn
————————

"Code đi kèm thì nó chạy rồi nhưng riêng code trong thisworkbook nó không tự động cập nhật được nên mỗi lần muốn chạy nó cứ phải mở toang ra rồi copy dán vào nó mới chạy

Hoàn toàn không hiểu vấn đề này nghĩa là sao nữa

Thực ra nhà em có ý định ghi tập tin đó dưới dạng có đuôi .xla để khi cần thì chỉ cần gọi ADD-in để nó nạp Code trên vào ThisWorkbook ( không phải mở tập tin khác để copy code vào thisWookbook ). Thực ra cũng là một cách trải nghiệm xem liệu mình làm được gì không . Cũng như đi tàu, nhà em muốn thò cổ ra ngoài xem gì có khác không thôi mà . Cám ơn và xin chào thày .

Thế thì thí nghiệm tiếp: bấm Alt + F8, chọn Auto_Open rồi bấm Run thì nó có chạy không?
Nếu nó vẫn không chèn được code vào Thisworkbook thì tôi hiểu vấn đề ở đâu rồi:
– Nếu bạn dùng Excel 2003 thì vào menu ToolsMacroSecurity —> Chuyển sang tab Trusted Publishers và check vào mục Trust access to Visual Basic Project
– Nếu bạn dùng Excel 2007 hoặc 2010, bấm tổ hợp phím Alt + T + M + S để vào phần Macro Settings và check vào mục Trust access to the VBA project object model
Xong chạy lại code —> Hy vọng đã đúng.. thuốc
Ẹc… Ẹc…

Thực ra nhà em mở hẳn mỗi thư mục mang tên một thày để lưu code hoặc công thức hay, nhà em không tin là code của thày không chạy . Nên chắc chắn do mình hoặc máy của nhà em có vấn đề . Tưởng thày chán "tên" học trò hay gây rắc rối, đang định vào thông báo và xin lỗi thày là đúng tên "Trust access to the VBA project object model" đã không được kích hoạt . Đúng thuốc rồi thày ạ !xin cám ơn sự tận tình giúp đỡ của thày .
Nhà em mạn phép hỏi thày Ndu thêm một chút . Tất cả ý tưởng thực hiện công việc nhà em đã hoàn tất . Nhưng sau khi hoàn tất lại thấy có vẻ không hợp lý lắm . Để thực hiện thay vì code đã được file .xla được gọi từ ADD-ins đã có code trên , lại phải impost nó từ ngoài vào . Vì vậy nhà em muốn thày giúp impost code trên sang thisWorkbook của bất kỳ file nào nếu đang mở song song cùng với tập tin có code này . Không biết có phiền thày không nữa ? Và cám ơn các thày đã không nặng lời khi thấy cái ý tưởng có vẻ dở hơi …

Cho toàn bộ code dưới đây vào 1 Module

Sub Auto_Open()
  With Application.CommandBars(1)
    .Reset
    With .Controls.Add(1, , , 1)
      .Caption = "Inset code"
      .OnAction = "InsertCode"
      .FaceId = 44
    End With
  End With
End Sub
Sub Auto_Close()
  Application.CommandBars(1).Reset
End Sub
Sub InsertCode()
  On Error Resume Next
  With ActiveWorkbook.VBProject
    With .VBComponents("ThisWorkbook")
      .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
      .CodeModule.InsertLines 1, _
      "Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)" & vbLf & _
      "  Application.ScreenUpdating = False" & vbLf & _
      "  On Error Resume Next" & vbLf & _
      "  Dim cond As FormatCondition" & vbLf & _
      "  If Target.Cells(1, 1).FormatConditions.Count > 0 Then" & vbLf & _
      "    Set cond = Target.Cells(1, 1).FormatConditions(1)" & vbLf & _
      "    If cond.Formula1 = ""=ROW()=CELL(""""ROW"""")"" Then" & vbLf & _
      "      Target.Calculate" & vbLf & _
      "    End If" & vbLf & _
      "    Set cond = Nothing" & vbLf & _
      "  End If" & vbLf & _
      "  Application.ScreenUpdating = True" & vbLf & _
      "End Sub"
    End With
    If Err.Number = 0 Then MsgBox "successfully inserted code into 'Thisworkbook'"
  End With
End Sub

Save File thành AddIn
Gọi AddIn lên, bạn sẽ nhìn thấy 1 menu mới được tạo ra trên thanh menu (với tên là Insert code). Bấm vào nút Insert code rồi kiểm tra xem code đã được chèn vào file hiện hành chưa

Save File thành AddIn
Gọi AddIn lên, bạn sẽ nhìn thấy 1 menu mới được tạo ra trên thanh menu (với tên là Insert code). Bấm vào nút Insert code rồi kiểm tra xem code đã được chèn vào file hiện hành chưa

Cám ơn thày NDU! code chạy tốt rồi ạ ? GPE dạo này "chật quá" chen mãi không vào được, mà có vẻ "đỏng đảnh" nữa, lúc chạy rầm rầm lúc lại ì ra như bị "bó phanh", sốt cả ruột. Bấm nút cảm ơn không thì nhà em cảm thấy vẫn chưa an tâm, nếu ở gần nhà em phải đến tận nơi để cám ơn thày .

www.giaiphapexcel.com/diendan/threads/ca%CC%81ch-xo%CC%81a-%C4%91oa%CC%A3n-code-cu%CC%83-thay-th%C3%AA%CC%81-b%C4%83%CC%80ng-1-%C4%91oa%CC%A3n-code-m%C6%A1%CC%81i-ma%CC%80-kh%C3%B4ng-m%C6%A1%CC%89-file.36225/

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học