Code để thêm code VBA vào file khác không hoạt động (1 người xem)

[minhtungph]

Mình có code như phía dưới, khi mở file lên sẽ chọn 1 file cần thêm sub Auto_open vào, tuy nhiên theo logic thì đúng mà nó vẫn chưa hoạt động theo ý muốn.

Sub ImportModule(ByVal fileName As String)
  Dim tmpFile, code As String
  On Error GoTo ExitSub
  Application.ScreenUpdating = False
  code = "Sub Auto_Open" & vbCrLf & _
            "Dim i as Long" & vbCrLf & _
            "For i = 1 to Sheets.Count" & vbCrLf & _
              "Sheets(i).Visible = -1" & vbCrLf & _
             "Next" & vbCrLf & _
          "End Sub"
  With New Scripting.FileSystemObject
    tmpFile = "C:\tmpFile.txt"
    .OpenTextFile(tmpFile, ForWriting, True).Write (code)
  End With
  With Workbooks.Open(fileName)
    ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & tmpFile & """)")
    .Close (True)
  End With
  Kill tmpFile
ExitSub:
  Application.ScreenUpdating = True
End Sub

 

[giaiphap]

Mình thì không hứng thú với cái này, nhưng thấy bạn hỏi search trên google, làm hơi khác với bạn một chút bạn xem có giúp ích được gì không.

 

[minhtungph]

cám ơn bạn. thật sự thấy thầy NDU giới thiệu đoạn này: ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & tmpFile & """)")
nên cố áp dụng mà không thành công.

 

[hungpecc1]

Mình có code như phía dưới, khi mở file lên sẽ chọn 1 file cần thêm sub Auto_open vào, tuy nhiên theo logic thì đúng mà nó vẫn chưa hoạt động theo ý muốn.

Sub ImportModule(ByVal fileName As String)
  Dim tmpFile, code As String
  On Error GoTo ExitSub
  Application.ScreenUpdating = False
  code = "Sub Auto_Open" & vbCrLf & _
            "Dim i as Long" & vbCrLf & _
            "For i = 1 to Sheets.Count" & vbCrLf & _
              "Sheets(i).Visible = -1" & vbCrLf & _
             "Next" & vbCrLf & _
          "End Sub"
  With New Scripting.FileSystemObject
    tmpFile = "C:\tmpFile.txt"
    .OpenTextFile(tmpFile, ForWriting, True).Write (code)
  End With
  With Workbooks.Open(fileName)
    ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & tmpFile & """)")
    .Close (True)
  End With
  Kill tmpFile
ExitSub:
  Application.ScreenUpdating = True
End Sub

bạn bỏ code dòng on error goto exitsub, xem code báo lỗi ở dòng nào
rồi ta gỡ dần !

 

[ndu96081631]

Mình có code như phía dưới, khi mở file lên sẽ chọn 1 file cần thêm sub Auto_open vào, tuy nhiên theo logic thì đúng mà nó vẫn chưa hoạt động theo ý muốn.

Sub ImportModule(ByVal fileName As String)
  Dim tmpFile, code As String
  On Error GoTo ExitSub
  Application.ScreenUpdating = False
  code = "Sub Auto_Open" & vbCrLf & _
            "Dim i as Long" & vbCrLf & _
            "For i = 1 to Sheets.Count" & vbCrLf & _
              "Sheets(i).Visible = -1" & vbCrLf & _
             "Next" & vbCrLf & _
          "End Sub"
  With New Scripting.FileSystemObject
    [COLOR=#ff0000]tmpFile = "C:\tmpFile.txt"[/COLOR]
    .OpenTextFile(tmpFile, ForWriting, True).Write (code)
  End With
  With Workbooks.Open(fileName)
    ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & tmpFile & """)")
    .Close (True)
  End With
  Kill tmpFile
ExitSub:
  Application.ScreenUpdating = True
End Sub

Nếu máy tính của bạn cài từ Windows 7 trở lên thì khả năng đoạn màu đỏ sẽ không chạy (do UAC cấm không cho ghi file vào phân vùng HĐH)
Vậy bạn thay đoạn màu đỏ thành:

tmpFile = .GetTempName

-----------------------
Ngoài ra, bạn phải vào Excel Options\Trust Center\Trust Center Settings...\Macro Settings và check mục "Trust access to... " trước khi chạy code nhé