Giúp cháu sửa code báo lổi Runtime error 5 khi vùng cần copy có tiếng việt

Liên hệ QC

1+1=2

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
5/7/20
Bài viết
62
Được thích
12
Cháu xin chào tất cả cô chú anh chị diễn đàn Excel. Cháu có dùng đoạn code sau để copy dữ liệu trong excel xuất ra file Notepad đã chỉ định tại đường dẩn ô U1. Không hiểu sao code chạy lổi khi dữ liệu có dấu tiếng việt, còn không dấu thì không sao

1594713953649.png

1594714043840.png

Code

Mã:
Sub xuatexcelnotepad()
'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String

    ' Nguon copy
    Set rngData = Range("a1:s200")
    rngData.Copy

    ' mac dinh
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        strData = .GetText
    End With

    ' nguon notepad
    strTempFile = Range("U1").Value
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(strTempFile, True).Write strData
    End With

    ' Mo file Notepad len
    'Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide
 
    Application.CutCopyMode = False


End Sub

Nhờ các cô chú xem giúp. Cháu cảm ơn thật nhiều. Chúc tất cả mọi người vui vẻ hạnh phúc bên gia đình và người thân
 

File đính kèm

  • 1594713234220.png
    1594713234220.png
    66.9 KB · Đọc: 1
  • 1594713280385.png
    1594713280385.png
    66.9 KB · Đọc: 1
  • 1594713366986.png
    1594713366986.png
    6.8 KB · Đọc: 1
  • Testcode.rar
    13 KB · Đọc: 7
Lần chỉnh sửa cuối:
Upvote 0
Cháu xin chào tất cả cô chú anh chị diễn đàn Excel. Cháu có dùng đoạn code sau để copy dữ liệu trong excel xuất ra file Notepad đã chỉ định tại đường dẩn ô U1. Không hiểu sao code chạy lổi khi dữ liệu có dấu tiếng việt, còn không dấu thì không sao

View attachment 241119

View attachment 241121

Code

Mã:
Sub xuatexcelnotepad()
'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String

    ' Nguon copy
    Set rngData = Range("a1:s200")
    rngData.Copy

    ' mac dinh
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        strData = .GetText
    End With

    ' nguon notepad
    strTempFile = Range("U1").Value
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(strTempFile, True).Write strData
    End With

    ' Mo file Notepad len
    'Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide

    Application.CutCopyMode = False


End Sub

Nhờ các cô chú xem giúp. Cháu cảm ơn thật nhiều. Chúc tất cả mọi người vui vẻ hạnh phúc bên gia đình và người thân
Sửa chỗ:
Mã:
With CreateObject("Scripting.FileSystemObject")
  .CreateTextFile(strTempFile, True).Write strData
End With
thành vầy:
Mã:
CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True, True).Write strData
xem sao
--------------------------------------
 
Upvote 0
With CreateObject("Scripting.FileSystemObject")
.CreateTextFile(strTempFile, True,true).Write strData
End With
Bạn phải sử dụng thuoc tính unicode
 
Upvote 0
Sửa chỗ:
Mã:
With CreateObject("Scripting.FileSystemObject")
  .CreateTextFile(strTempFile, True).Write strData
End With
thành vầy:
Mã:
CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True, True).Write strData
xem sao
--------------------------------------
Quá hay chú ạ. cháu thử nảy giờ 4 5 lần code chạy ok hết kể cả tiếng phát tiếng mỹ . Cháu cảm ơn chú nhiều. Chú chúc 1 buổi tối vui vẻ hạnh phúc bên gia đình
 
Upvote 0
Sửa chỗ:
Mã:
With CreateObject("Scripting.FileSystemObject")
  .CreateTextFile(strTempFile, True).Write strData
End With
thành vầy:
Mã:
CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True, True).Write strData
xem sao
--------------------------------------

Cháu mới thử lại nó còn 1 trường hợp này nữa vẫn . Mong chú giúp cháu 1 lần nữa.
Nghĩa là nếu vùng copy mà bị ẩn thì nó bỏ qua vùng ẩn
Ví dụ Vùng copy là A1:E1000 mà cháu ẩn từ hàng 100 đến 1000 . thì code nó chỉ copy vùng đang hiện là A1:E99. Vậy sửa code làm sao để nó copy đúng địa chỉ Copy đã cho trước không quan trọng vùng đó đã hiện hay đã ẩn. Mong chú giúp cái này nữa là quá tuyệt vời. Cháu xin cảm ơn chú trước
Bài đã được tự động gộp:

With CreateObject("Scripting.FileSystemObject")
.CreateTextFile(strTempFile, True,true).Write strData
End With
Bạn phải sử dụng thuoc tính unicode

Cháu mới thử lại nó còn 1 trường hợp này nữa vẫn . Mong chú giúp cháu 1 lần nữa.
Nghĩa là nếu vùng copy mà bị ẩn thì nó bỏ qua vùng ẩn
Ví dụ Vùng copy là A1:E1000 mà cháu ẩn từ hàng 100 đến 1000 . thì code nó chỉ copy vùng đang hiện là A1:E99. Vậy sửa code làm sao để nó copy đúng địa chỉ Copy đã cho trước không quan trọng vùng đó đã hiện hay đã ẩn. Mong chú giúp cái này nữa là quá tuyệt vời. Cháu xin cảm ơn chú trước
 
Upvote 0
Cháu mới thử lại nó còn 1 trường hợp này nữa vẫn . Mong chú giúp cháu 1 lần nữa.
Nghĩa là nếu vùng copy mà bị ẩn thì nó bỏ qua vùng ẩn
Ví dụ Vùng copy là A1:E1000 mà cháu ẩn từ hàng 100 đến 1000 . thì code nó chỉ copy vùng đang hiện là A1:E99. Vậy sửa code làm sao để nó copy đúng địa chỉ Copy đã cho trước không quan trọng vùng đó đã hiện hay đã ẩn. Mong chú giúp cái này nữa là quá tuyệt vời. Cháu xin cảm ơn chú trước
Bài đã được tự động gộp:



Cháu mới thử lại nó còn 1 trường hợp này nữa vẫn . Mong chú giúp cháu 1 lần nữa.
Nghĩa là nếu vùng copy mà bị ẩn thì nó bỏ qua vùng ẩn
Ví dụ Vùng copy là A1:E1000 mà cháu ẩn từ hàng 100 đến 1000 . thì code nó chỉ copy vùng đang hiện là A1:E99. Vậy sửa code làm sao để nó copy đúng địa chỉ Copy đã cho trước không quan trọng vùng đó đã hiện hay đã ẩn. Mong chú giúp cái này nữa là quá tuyệt vời. Cháu xin cảm ơn chú trước
Có nhiều cách để lấy dữ liệu từ một Range mà copy rồi "moi" mọi thứ từ trong clipboard là cách khá đơn giản. Tuy nhiên nó cũng có giới hạn, chính là không thể lấy được dữ liệu mà nó không "nhìn thấy" (dòng ẩn)
Vậy trong trường hợp của bạn, cứ dùng cách bình thường là được:
Mã:
Private Sub Data2txtFile(ByVal Range2Export As Range, ByVal txtFile As String)
  Dim aSource, tmp(), Arr(), lR As Long, lC As Long
  On Error GoTo ExitSub
  aSource = Range2Export.Value
  If Not IsArray(aSource) Then
    ReDim aSource(1 To 1, 1 To 1)
    aSource(1, 1) = Range2Export.Value
  End If
  If UCase(Right(txtFile, 4)) <> ".TXT" Then txtFile = txtFile & ".txt"
  ReDim tmp(1 To UBound(aSource, 2))
  ReDim Arr(1 To UBound(aSource, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(aSource, 1)
        For lC = 1 To UBound(aSource, 2)
          tmp(lC) = aSource(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
ExitSub:
End Sub
Sub xuatexcelnotepad()
'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    ' Nguon copy
    Set rngData = Range("A1:S200")
    strTempFile = Range("U1").Value
    Data2txtFile rngData, strTempFile
    ' Mo file Notepad len
    Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide
End Sub
Nói chung là cách nào cũng có ưu điểm, nhược điểm riêng, tùy chuyện mà xài thôi
 
Upvote 0
Tớ nghĩ cậu cho nó hiện
Có nhiều cách để lấy dữ liệu từ một Range mà copy rồi "moi" mọi thứ từ trong clipboard là cách khá đơn giản. Tuy nhiên nó cũng có giới hạn, chính là không thể lấy được dữ liệu mà nó không "nhìn thấy" (dòng ẩn)
Vậy trong trường hợp của bạn, cứ dùng cách bình thường là được:
Mã:
Private Sub Data2txtFile(ByVal Range2Export As Range, ByVal txtFile As String)
  Dim aSource, tmp(), Arr(), lR As Long, lC As Long
  On Error GoTo ExitSub
  aSource = Range2Export.Value
  If Not IsArray(aSource) Then
    ReDim aSource(1 To 1, 1 To 1)
    aSource(1, 1) = Range2Export.Value
  End If
  If UCase(Right(txtFile, 4)) <> ".TXT" Then txtFile = txtFile & ".txt"
  ReDim tmp(1 To UBound(aSource, 2))
  ReDim Arr(1 To UBound(aSource, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(aSource, 1)
        For lC = 1 To UBound(aSource, 2)
          tmp(lC) = aSource(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
ExitSub:
End Sub
Sub xuatexcelnotepad()
'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    ' Nguon copy
    Set rngData = Range("A1:S200")
    strTempFile = Range("U1").Value
    Data2txtFile rngData, strTempFile
    ' Mo file Notepad len
    Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide
End Sub
Nói chung là cách nào cũng có ưu điểm, nhược điểm riêng, tùy chuyện mà xài thôi
very Good
 
Upvote 0
Có nhiều cách để lấy dữ liệu từ một Range mà copy rồi "moi" mọi thứ từ trong clipboard là cách khá đơn giản. Tuy nhiên nó cũng có giới hạn, chính là không thể lấy được dữ liệu mà nó không "nhìn thấy" (dòng ẩn)
Vậy trong trường hợp của bạn, cứ dùng cách bình thường là được:
Mã:
Private Sub Data2txtFile(ByVal Range2Export As Range, ByVal txtFile As String)
  Dim aSource, tmp(), Arr(), lR As Long, lC As Long
  On Error GoTo ExitSub
  aSource = Range2Export.Value
  If Not IsArray(aSource) Then
    ReDim aSource(1 To 1, 1 To 1)
    aSource(1, 1) = Range2Export.Value
  End If
  If UCase(Right(txtFile, 4)) <> ".TXT" Then txtFile = txtFile & ".txt"
  ReDim tmp(1 To UBound(aSource, 2))
  ReDim Arr(1 To UBound(aSource, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(aSource, 1)
        For lC = 1 To UBound(aSource, 2)
          tmp(lC) = aSource(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
ExitSub:
End Sub
Sub xuatexcelnotepad()
'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    ' Nguon copy
    Set rngData = Range("A1:S200")
    strTempFile = Range("U1").Value
    Data2txtFile rngData, strTempFile
    ' Mo file Notepad len
    Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide
End Sub
Nói chung là cách nào cũng có ưu điểm, nhược điểm riêng, tùy chuyện mà xài thôi

Quá tuyệt vời . cháu cảm ơn chú nhiều
 
Upvote 0
Web KT
Back
Top Bottom