Vọc chơi với những thuật toán nén và giải nén file (1 người xem)

ndu96081631 · 23/9/15

Tôi mở topic này nhằm mục đích cùng nhau nghiên cứu về nén và giải nén dùng công cụ VBA
Đầu tiên chúng ta cùng làm cuộc thí nghiệm nhỏ sau:
- Click chuột phải trên Desktop, chọn New ---> WinRAR archive (hoặc WinRAR Zip archive). Đương nhiên ta sẽ nhận được một file RAR hoặc ZIP trắng
- Tiếp theo khởi động Notepad
- Dùng chuột nắm kéo file RAR (hoặc ZIP) mới vừa tạo thả vào cửa sổ Notepad
Các bạn nhìn thấy cái gì trong Notepad?
Mời trả lời rồi chúng ta sẽ tiếp tục

Vo Tinh · 23/9/15

ndu96081631 đã viết:
Tôi mở topic này nhằm mục đích cùng nhau nghiên cứu về nén và giải nén dùng công cụ VBA
Đầu tiên chúng ta cùng làm cuộc thí nghiệm nhỏ sau:
- Click chuột phải trên Desktop, chọn New ---> WinRAR archive (hoặc WinRAR Zip archive). Đương nhiên ta sẽ nhận được một file RAR hoặc ZIP trắng
- Tiếp theo khởi động Notepad
- Dùng chuột nắm kéo file RAR (hoặc ZIP) mới vừa tạo thả vào cửa sổ Notepad
Các bạn nhìn thấy cái gì trong Notepad?
Mời trả lời rồi chúng ta sẽ tiếp tục

Nhìn thấy thế này trong notepad

Rar! ϐs

Kiều Mạnh · 23/9/15

ndu96081631 đã viết:
Tôi mở topic này nhằm mục đích cùng nhau nghiên cứu về nén và giải nén dùng công cụ VBA
Đầu tiên chúng ta cùng làm cuộc thí nghiệm nhỏ sau:
- Click chuột phải trên Desktop, chọn New ---> WinRAR archive (hoặc WinRAR Zip archive). Đương nhiên ta sẽ nhận được một file RAR hoặc ZIP trắng
- Tiếp theo khởi động Notepad
- Dùng chuột nắm kéo file RAR (hoặc ZIP) mới vừa tạo thả vào cửa sổ Notepad
Các bạn nhìn thấy cái gì trong Notepad?
Mời trả lời rồi chúng ta sẽ tiếp tục

Em Thấy như sau....Nhưng sau khi kéo vào Notepad thì mở lại File rar báo lỗi
Rar! ϐs

leonguyenz · 23/9/15

Sao mình lại ra chữ này: PK|-

ndu96081631 · 23/9/15

leonguyenz đã viết:
Sao mình lại ra chữ này: PK|-

OK! những ai nhìn thấy PK|- có nghĩa là đang test với ZIP file, ngược lại là đang test với RAR file
-------------------
Ở đây chúng ta bắt đầu quan tâm đến ZIP (RAR cho qua nhé)
Vậy các bạn thử thí nghiệm tiếp:
- Mở Notepad
- Gõ vào nội dung PK|-
- Lưu ý rằng ký tự "-" có charcode = 6 nha chứ không phải ký tự cạnh dấu = đâu (tốt nhất cứ copy cái PK|- hồi nảy rồi paste cho chắc ăn)
- Xong Save As lên Desktop với tên abc.zip
- Đóng Notepad và double clikc vào abc.zip xem có được không?

doveandrose · 23/9/15

ndu96081631 đã viết:
OK! những ai nhìn thấy PK|- có nghĩa là đang test với ZIP file, ngược lại là đang test với RAR file
-------------------
Ở đây chúng ta bắt đầu quan tâm đến ZIP (RAR cho qua nhé)
Vậy các bạn thử thí nghiệm tiếp:
- Mở Notepad
- Gõ vào nội dung PK|-
- Lưu ý rằng ký tự "-" có charcode = 6 nha chứ không phải ký tự cạnh dấu = đâu (tốt nhất cứ copy cái PK|- hồi nảy rồi paste cho chắc ăn)
- Xong Save As lên Desktop với tên abc.zip
- Đóng Notepad và double clikc vào abc.zip xem có được không?

nếu chỉ copy có 4 ký tự rồi save as zip file thì mở bằng zip được nhưng không giải nén được
nếu copy 4 kí tự với 1 số ký tự null gì đó đằng sau rồi save as zip thì giải nén mới không báo lỗi . nhưng giải nén hổng ra cái gì . chỉ là không báo lỗi như khi giải nén với 4 kí tự thôi

ndu96081631 · 23/9/15

doveandrose đã viết:
nếu chỉ copy có 4 ký tự rồi save as zip file thì mở bằng zip được nhưng không giải nén được
nếu copy 4 kí tự với 1 số ký tự null gì đó đằng sau rồi save as zip thì giải nén mới không báo lỗi . nhưng giải nén hổng ra cái gì . chỉ là không báo lỗi như khi giải nén với 4 kí tự thôi

OK! Thì cứ từ từ thí nghiệm chứ

doveandrose · 23/9/15

ndu96081631 đã viết:
OK! Thì cứ từ từ thí nghiệm chứ

thầy giáo cứ nói tiếp đi ạ . ( chứ nếu không nói thì các học trò cũng đâu biết gì để làm ) hi hi

ndu96081631 · 23/9/15

doveandrose đã viết:
thầy giáo cứ nói tiếp đi ạ . ( chứ nếu không nói thì các học trò cũng đâu biết gì để làm ) hi hi

Mục đích cuối cùng là nén 1 file nào đó thành file ZIP hoặc giải nén 1 file ZIP ra 1 thư mục
Vậy thôi!
Tuy nhiên để nén file, nếu làm bằng tay thì dễ chứ còn code thì phải "dạy" nó từ từ:
- Tạo 1 file zip trắng (như nảy giờ bàn)
- Xong kéo file cần zip vào file zip trắng này
Vậy là ta có được file nén rồi
----------------------
Nói thêm 1 chút: Với file dạng XLSX hoặc XLSM, nếu đổi đuôi thành .ZIP rồi mở lên thì ta sẽ có được 1 nội dung hoàn toàn khác đồng thời có thể làm được rất nhiều thứ bên trong nó (chẳng hạn Edit lại các file dạng xml để làm Ribbon hay xóa style, name.. vân vân...)

doveandrose · 23/9/15

hpkhuong đã viết:
Vâng. bài tới đây kết thúc. Bùm Bùm Bùm (3 hồi trống)..........học trò giải tán!!! $-\\/.$ $-\\/.$ $-\\/.$

gì zô ziêng zậy bạn . mình chưa muốn về bạn ơi .

ndu96081631 · 23/9/15

Ai đó thử tạo 1 NewZipFile bằng VBA như nảy giờ bàn xem!
(bằng Scripting.FileSystemObject CreateTextFile theo nội dung đã biết)

leonguyenz · 23/9/15

ndu96081631 đã viết:
Ai đó thử tạo 1 NewZipFile bằng VBA như nảy giờ bàn xem!
(bằng Scripting.FileSystemObject CreateTextFile theo nội dung đã biết)

Cái này emchỉ ngồi hóng cao thủ thôi.
Add đề tài này cái đã, tối về ngâm cứu tiếp.

doveandrose · 23/9/15

ndu96081631 đã viết:
Ai đó thử tạo 1 NewZipFile bằng VBA như nảy giờ bàn xem!
(bằng Scripting.FileSystemObject CreateTextFile theo nội dung đã biết)

Mã:

Public Sub hell()
Dim fso As Object, oFile As Object, strPath As String
Set fso = CreateObject("Scripting.FileSystemObject")
strPath = ThisWorkbook.Path & "\abc.zip"
Set oFile = fso.CreateTextFile(strPath)
oFile.WriteLine Sheet1.Range("A1").Value
oFile.Close
Set fso = Nothing
Set oFile = Nothing
End Sub

kí tự char(6) không copy được lên diễn đàn hay sao ấy thầy ơi

ndu96081631 · 23/9/15

doveandrose đã viết:
Mã:

Public Sub hell() Dim fso As Object, oFile As Object, strPath As String Set fso = CreateObject("Scripting.FileSystemObject") strPath = ThisWorkbook.Path & "\abc.zip" Set oFile = fso.CreateTextFile(strPath) oFile.WriteLine Sheet1.Range("A1").Value oFile.Close Set fso = Nothing Set oFile = Nothing End Sub

kí tự char(6) không copy được lên diễn đàn hay sao ấy thầy ơi

Thì viết oFile.WriteLine "PK" & Chr(5) & Chr(6) & String(18, 0) cũng được vậy (biết charcode của nó rồi còn gì)

ndu96081631 · 23/9/15

OK! Mình viết như vầy:

Mã:

Function NewZip(ByVal ZipFile As String) As Boolean
  Dim fso As Object
  On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  With fso.CreateTextFile(ZipFile, True)
    .Write "PK" & Chr(5) & Chr(6) & String(18, 0)
    .Close
  End With
  NewZip = (Err.Number = 0)
  Exit Function
ErrHandler:   MsgBox Err.Description
End Function

Mã:

Sub Main()
  Dim bRet As Boolean
  bRet = NewZip("D:\abc.zip")
  If bRet Then MsgBox "Done!"
End Sub

Phải tạo thành Function hoặc sub có tham số truyền để còn làm nhiều việc sau đó nữa
----------------------
mời test thừ và cho biết kết quả rồi ta sẽ tính tiếp những bước sau

Kiều Mạnh · 23/9/15

ndu96081631 đã viết:
OK! Mình viết như vầy:

Mã:

Function NewZip(ByVal ZipFile As String) As Boolean Dim fso As Object On Error GoTo ErrHandler Set fso = CreateObject("Scripting.FileSystemObject") With fso.CreateTextFile(ZipFile, True) .Write "PK" & Chr(5) & Chr(6) & String(18, 0) .Close End With NewZip = (Err.Number = 0) Exit Function ErrHandler: MsgBox Err.Description End Function

Mã:

Sub Main() Dim bRet As Boolean bRet = NewZip("D:\abc.zip") If bRet Then MsgBox "Done!" End Sub

Phải tạo thành Function hoặc sub có tham số truyền để còn làm nhiều việc sau đó nữa
----------------------
mời test thừ và cho biết kết quả rồi ta sẽ tính tiếp những bước sau

Nó tạo ra một file zip rỗng Anh ... giải nén ra là lỗi ... mở lên thì OK

doveandrose · 23/9/15

kieu manh đã viết:
Nó tạo ra một file zip rỗng Anh ... giải nén ra là lỗi ... mở lên thì OK

có 1 con số 0 trong code của thầy Tuấn là "nhá" thôi . tí thầy ấy sửa lại con số 0 này cho xem nè

ndu96081631 · 23/9/15

kieu manh đã viết:
Nó tạo ra một file zip rỗng Anh ... giải nén ra là lỗi ... mở lên thì OK

Từ từ mà đồng chí!
Tiếp theo, từ file Zip rổng ấy, ta sẽ cho file của ta (file gì tùy ý) vào trong đó. Khi ấy file Zip sẽ có nội dung thôi

Kiều Mạnh · 23/9/15

ndu96081631 đã viết:
Từ từ mà đồng chí!
Tiếp theo, từ file Zip rổng ấy, ta sẽ cho file của ta (file gì tùy ý) vào trong đó. Khi ấy file Zip sẽ có nội dung thôi

Thì cũng giống như mình kéo thả một file mới vào đó thôi .... giả nén thì được một file mới kéo vào

ndu96081631 · 23/9/15

kieu manh đã viết:
Thì cũng giống như mình kéo thả một file mới vào đó thôi .... giả nén thì được một file mới kéo vào

Vâng! Chính xác là vậy!
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"
Nén và giải nén có giải thuật gần giống nhau. Sau khi có bước đầu thành công, ta sẽ tính đến việc giải nén file XLSX, XLSM và làm đủ thứ việc trong đó (chẳng hạn làm Ribbon tự tạo)

VMH0307 · 23/9/15

Em xin góp vui, thay vì dùng CreateObject("Scripting.FileSystemObject"), ta có thể dùng thế này để tạo file zip cũng được:
[gpecode=vb]
Function NewZip(ByVal ZipFile As String) As Boolean
On Error GoTo ErrHandler
Open ZipFile For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
NewZip = (Err.Number = 0)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
[/gpecode]

VMH0307 · 23/9/15

ndu96081631 đã viết:
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"

Nếu em không lầm thì để zip 1 file thì ta có thể làm như sau:
[gpecode=vb]Sub ZipTool(ByVal Sourcefile As String)
Dim Zipfile As String
Zipfile = Sourcefile & ".zip"
FileCopy Sourcefile, Zipfile
End Sub[/gpecode]

doatmenhhon · 23/9/15

ndu96081631 đã viết:
Từ từ mà đồng chí!
Tiếp theo, từ file Zip rổng ấy, ta sẽ cho file của ta (file gì tùy ý) vào trong đó. Khi ấy file Zip sẽ có nội dung thôi

Hóng

doveandrose · 23/9/15

ndu96081631 đã viết:
Vâng! Chính xác là vậy!
Phần quan trọng là code VBA sao để nén 1 file "D:\abc.xls" thành "D:\abc.zip"
Nén và giải nén có giải thuật gần giống nhau. Sau khi có bước đầu thành công, ta sẽ tính đến việc giải nén file XLSX, XLSM và làm đủ thứ việc trong đó (chẳng hạn làm Ribbon tự tạo)

thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

leonguyenz · 24/9/15

doveandrose đã viết:
thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

Bài #10 có nói đó "bà chị", tiếp theo làm như bài #22 /-*+/

Kiều Mạnh · 24/9/15

Mình nghe thấy làm được cái này (chẳng hạn làm Ribbon tự tạo) là mê lắm .... vì đang kẹt cái đó nghiên cứu làm hoài nó cứ lỗi tùm lum

quocphuoc88 · 24/9/15

doveandrose đã viết:
thầy ơi cho em hỏi ta nén "D:\abc.xls" thành "D:\abc.zip" để làm gì ? em chỉ hiểu theo nghĩa đen là tạo ra 1 file abc.zip . trong file này lại chứa 1 file abc.xls . xin thầy nói thêm 1 chút để tụi em hiểu rõ hơn

Thiết nghĩ chắc Thầy Ndu đang hướng dẫn tùy chỉnh cái Ribbon tự tạo hoặc 1 vài cái khác . Mà cái tùy chỉnh Ribbon nào e cũng đang 'Chết mê chết mệt' với nó đây. Huy vọng qua topic này học được vài cái hay nữa ! @$@!^%

leonguyenz · 24/9/15

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Kiều Mạnh · 24/9/15

quocphuoc88 đã viết:
Thiết nghĩ chắc Thầy Ndu đang hướng dẫn tùy chỉnh cái Ribbon tự tạo hoặc 1 vài cái khác . Mà cái tùy chỉnh Ribbon nào e cũng đang 'Chết mê chết mệt' với nó đây. Huy vọng qua topic này học được vài cái hay nữa !

Nếu cũng Mê thì mình Úp thêm cái này nữa liên quan tới Ribbon cho bạn nào chưa có tải về mà dùng....nói chung đồ chơi mình có gần đủ hết chỉ làm là nó tịt.... }}}}}

Kiều Mạnh · 24/9/15

leonguyenz đã viết:

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Kiếm ở đâu ra cái mớ rau muống này vậy.... cách xào nấu làm sao để nhậu được...leonguyenz Chỉ dùm đi
Xin cảm ơn

ndu96081631 · 24/9/15

VMH0307 đã viết:
Em xin góp vui, thay vì dùng CreateObject("Scripting.FileSystemObject"), ta có thể dùng thế này để tạo file zip cũng được:
[gpecode=vb]
Function NewZip(ByVal ZipFile As String) As Boolean
On Error GoTo ErrHandler
Open ZipFile For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
NewZip = (Err.Number = 0)
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
[/gpecode]

Cách này tôi có biết nhưng tôi sẽ không dùng, bởi ngoài chuyện hơi khó hiểu ra thì điều quan trọng là nó không hỗ trợ tên file tiếng Việt có dấu
-----------------

VMH0307 đã viết:
Nếu em không lầm thì để zip 1 file thì ta có thể làm như sau:
[gpecode=vb]Sub ZipTool(ByVal Sourcefile As String)
Dim Zipfile As String
Zipfile = Sourcefile & ".zip"
FileCopy Sourcefile, Zipfile
End Sub[/gpecode]

Cách này càng không được, bởi file Zip tạo ra không dùng được. Tuy nhiên cách này lại có thể dùng khi ta cần edit file xml bên trong file xlsx, xlsm (bằng cách đổi đuôi file xlsx, xlsm thành xlsx.zip, xlsm.zip rồi mở lên lấy nội dung bên trong)

ndu96081631 · 24/9/15

leonguyenz đã viết:

Ý thầy ndu là đọc hiểu và xào nấu mớ rau muống sau rồi đưa vào code phải không ạ:

Mã:

PK-      ! q9+p                      [Content_Types].xmlPK-      ! µU0#ơ   L               |  _rels/.relsPK-      ! ̃    ư(  Ô               h  xl/_rels/workbook.xml.relsPK-      ! @97é_  q               ª  xl/workbook.xmlPK-      ! é¦%¸‚  S               6
  xl/theme/theme1.xmlPK-      ! G$î  º               é  xl/worksheets/sheet2.xmlPK-      ! G$î  º               6  xl/worksheets/sheet3.xmlPK-      ! ₫äŸ   º                ƒ  xl/sharedStrings.xmlPK-      ! ómóh–  M  
             T  xl/styles.xmlPK-      ! B;_  @                 xl/worksheets/sheet1.xmlPK-      ! Iđ@>  [               ª  docProps/core.xmlPK-      ! —€LÖŸ  V                 docProps/app.xmlPK        ô

Tôi nhớ không lầm thì để làm ribbon người ta tạo ra file CustomUI.xml với cả đống lệnh trong đó. Vậy nên tôi có ý tưởng:
- Dùng VBA tạo ra cái đống lệnh rồi Save thành file CustomUI.xml
- Tiếp theo bằng phương pháp nén file (như chủ đề topic này) ta sẽ đưa CustomUI.xml vào bên trong file xlsm
Quy trình là vậy nhưng để thực thi nó thì vẫn còn nhiều bước lắm. Từ từ chúng ta cùng nghiên cứu vậy!
(Tôi ghét ribbon bởi luôn phải có công đoạn làm bằng tay. Nếu như toàn bộ đều bằng code thì.. chuyện ngon rồi)

ndu96081631 · 24/9/15

"Công trình" đầu tiên

Đây là "công trình" đầu tiên của việc nén file:

Mã:

Private Function CreateNewZip(ByVal ZipFilePath As String) As String
 'Create an empty ZIP file
  Dim FSO, sBin As String
  On Error GoTo ErrHandler
  If UCase(Right(ZipFilePath, 4)) = ".ZIP" Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sBin = "PK" & Chr(5) & Chr(6) & String(18, 0)
    With FSO.CreateTextFile(ZipFilePath, True)
      .Write sBin
      .Close
    End With
    If Err.Number = 0 Then CreateNewZip = ZipFilePath
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function
Function FileToZip(ByVal [COLOR=#ff0000]FilePath[/COLOR]) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim [COLOR=#ff0000]ZipFilePath, sFolder, sName[/COLOR], sFile As String
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists(sFile) Then
    sFolder = FSO.GetFile(sFile).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace([COLOR=#ff0000]ZipFilePath[/COLOR]).CopyHere .Namespace([COLOR=#ff0000]sFolder[/COLOR]).Items.Item([COLOR=#ff0000]FilePath[/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function
Sub TestZipFile()
  Dim bRet As Boolean
  Dim vFile
  vFile = Application.GetOpenFilename("All Files, *.*")
  If TypeName(vFile) = "String" Then
    bRet = FileToZip(vFile)
    If bRet Then MsgBox "Done!"
  End If
End Sub

Mời test thử và cùng hoàn thiện
Lưu ý quan trọng(mất công các bạn tự làm bị lỗi mà không biết): Mấy cái biến màu đỏ tuy ta có thể dùng như chuỗi nhưng tuyệt đối không được khai báo nó dạng chuỗi (kiểu như Dim FilePath as String)... nếu không code lập tức báo lỗi. Các bạn có thể thay đổi 1 vài biến màu đỏ thành dạng As String và test thử
----------------------------------
Tôi nghiên cứu tới đâu đăng bài tới đó chứ chưa có gì sẵn trong đầu cả (chỉ có ý tưởng)... vậy nên xin mời các bạn góp sức hoàn thiện (tôi tin chắc vẫn còn lỗi ở đâu đó)
Cảm ơn

doveandrose · 24/9/15

ẹc thì ra đó là lý do . biểu sao qua giờ cứ gán kiểu String vào cái thằng .nameSpace() là nó lỗi . gán trực tiếp chuỗi vào thì lại được . ......

doveandrose · 24/9/15

báo cáo thầy là dòng này không làm việc trên máy em

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

mà phải vầy nó mới chịu

Mã:

.Namespace(ZipFilePath).CopyHere FilePath

ndu96081631 · 24/9/15

doveandrose đã viết:
báo cáo thầy là dòng này không làm việc trên máy em

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

mà phải vầy nó mới chịu

Mã:

.Namespace(ZipFilePath).CopyHere FilePath

Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

doveandrose · 24/9/15

ndu96081631 đã viết:
Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

em dùng cái này

Mã:

MsgBox TypeName(.Namespace(sFolder).Items.Item(FilePath))

nó cho em cái chữ "Nothing"

ndu96081631 · 24/9/15

doveandrose đã viết:
em dùng cái này

Mã:

MsgBox TypeName(.Namespace(sFolder).Items.Item(FilePath))

nó cho em cái chữ "Nothing"

Trên máy tôi thì nó là tên cái file cần nén
Ẹc... Ẹc... ứ biết cái gì trong trái ổi... Mò là chính, mò hoài không ra thì.. hết gân!

VMH0307 · 24/9/15

Như vậy, Em nghĩ theo cách làm thủ công thì chúng ta sẽ dùng vba để tạo ribbon với các bước sau:
1. Đổi tên file xlsx, xlsm... (ex 2007 trở lên) thành *.zip
2. Giải nén file của bước 1. Nếu muốn làm việc với Ribbon thì lấy ra file CustomUI.xml để sử dụng.
3. "Chế cháo" file CustomUI.xml và thay thế file customUI.xml gốc ban đầu
4. Tạo 1 file zip rỗng
5. Copy trở lại tất cả các file đã unzip ở bước 2 + file CustomUI.xml đã sửa đổi vào file zip rỗng ở bước 4
6. Đổi tên lại file zip ở bước 5 thành file xlsx, xlsm... như ban đầu.

ndu96081631 · 24/9/15

VMH0307 đã viết:
Như vậy, Em nghĩ theo cách làm thủ công thì chúng ta sẽ dùng vba để tạo ribbon với các bước sau:
1. Đổi tên file xlsx, xlsm... (ex 2007 trở lên) thành *.zip
2. Giải nén file của bước 1. Nếu muốn làm việc với Ribbon thì lấy ra file CustomUI.xml để sử dụng.
3. "Chế cháo" file CustomUI.xml và thay thế file customUI.xml gốc ban đầu
4. Tạo 1 file zip rỗng
5. Copy trở lại tất cả các file đã unzip ở bước 2 + file CustomUI.xml đã sửa đổi vào file zip rỗng ở bước 4
6. Đổi tên lại file zip ở bước 5 thành file xlsx, xlsm... như ban đầu.

Mình nghĩ từ bước 4 trở đi sẽ là:
4> Mang file CustomUI.xml đưa vào trong file xlsx.zip hoặc xlsm.zip (thủ tục nén file)
5> Đổi đuôi xlsx.zip hoặc xlsm.zip thành xlsx hoặc xlsm

huuthang_bd · 24/9/15

ndu96081631 đã viết:
Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.

Kiều Mạnh · 24/9/15

doveandrose đã viết:
em dùng cái này

Mã:

MsgBox TypeName(.Namespace(sFolder).Items.Item(FilePath))

nó cho em cái chữ "Nothing"

Sao máy mình chạy êm du luôn ...nén File cực tốt....Tại sao Ta ???????
win7+Wnxp+Office2010

doveandrose · 24/9/15

ndu96081631 đã viết:
Mình nghĩ từ bước 4 trở đi sẽ là:
4> Mang file CustomUI.xml đưa vào trong file xlsx.zip hoặc xlsm.zip (thủ tục nén file)
5> Đổi đuôi xlsx.zip hoặc xlsm.zip thành xlsx hoặc xlsm

thưa thầy . em không biết là các bạn bạn tham gia ở đây võ công cao đến đâu . nhưng mà cái việc chế ra file CUstomUI.xml là việc em nghĩ là không đơn giản . sao chúng ta không đi từng bước làm những cái đơn giản hơn trước . thí dụ như đọc dữ liệu từ các file sheet.xml , ghi ngược lại , vân vân để luyện kỹ năng làm việc với xml trước đã . rồi sau đó mới đủ vũ khí đi giết con đại bàng chứ .

ndu96081631 · 24/9/15

huuthang_bd đã viết:
Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.

Cố tình muốn xử lý theo kiểu chuỗi đấy mà (tại vì biến ở trên ta khai báo Variant)
Tại cái tật cẩn thận (muốn làm cái gì ra cái đó)
Ẹc... Ẹc...

doveandrose · 24/9/15

kieu manh đã viết:
Sao máy mình chạy êm du luôn ...nén File cực tốt....Tại sao Ta ???????
win7+Wnxp+Office2010

thôi được rồi . nếu máy ai cũng chạy được code của thầy NDU thì cứ thế tiến hành tiếp . tôi tùy biến theo máy tôi vậy

ndu96081631 · 24/9/15

doveandrose đã viết:
thưa thầy . em không biết là các bạn bạn tham gia ở đây võ công cao đến đâu . nhưng mà cái việc chế ra file CUstomUI.xml là việc em nghĩ là không đơn giản . sao chúng ta không đi từng bước làm những cái đơn giản hơn trước . thí dụ như đọc dữ liệu từ các file sheet.xml , ghi ngược lại , vân vân để luyện kỹ năng làm việc với xml trước đã . rồi sau đó mới đủ vũ khí đi giết con đại bàng chứ .

Thì tiêu chí từ đầu của tôi là... TỪ TỪ mà (đừng nóng vội sẽ hư bột hư sugar)... từ từ và chắc corn --=0

Tôi chỉ nêu cái "viễn cảnh" gây "kích thích" thôi!

huuthang_bd · 24/9/15

ndu96081631 đã viết:
Mình thật may mắn khi luôn có các bạn đồng hành! Cảm ơn
-----------------------------------------------------------------
Tôi test thử trên Windows 7 (32bit) + Office 2010 (32bit) thì cả 2 cách trên đều được
Vậy mời các bạn khác test thử, nếu thay đổi như anh Chim Hồng mà không máy nào báo lỗi thì ta sẽ thống nhất dùng code này
(mục đích để máy nào cũng dùng được)

Anh thử lại cách này thử có được không?

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

Lúc đầu máy em chạy được nhưng sau khi thử cách của bạn doveandrose bây giờ thử lại không được (File tạo ra bị lỗi). Chả hiểu.

quocphuoc88 · 24/9/15

máy e dòng này

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

Thì nén ra file rỗng
nhưng nếu:

.Namespace(ZipFilePath).CopyHere FilePath

Thì mở ra có file vừa chọn nằm trong đó
Máy e Win 8+ ofice 2013 ( 32 bit )

quocphuoc88 · 24/9/15

huuthang_bd đã viết:
Máy em cả 2 đền được (Win7 64bit, Office 2007 32bit)
Nhân tiện anh cho em hỏi các hàm có dấu $ (Left$, Right$, Mid$,... ) khác gì so với các hàm không có dấu này (Left, Right, Mid,... ). Em thử các hàm không có dấu $ thì kết quả vẫn không có gì khác.

E nhớ không lầm là nếu thêm dấu $ sau các hàm xử lý chuỗi thì tốc độ nhanh hơn xí ah a ! ( có đọc đâu đó rồi nhưng không nhớ )

ndu96081631 · 24/9/15

huuthang_bd đã viết:
Anh thử lại cách này thử có được không?

Mã:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

Lúc đầu máy em chạy được nhưng sau khi thử cách của bạn doveandrose bây giờ thử lại không được (File tạo ra bị lỗi). Chả hiểu.

Vừa test lại xong, đổi qua lại giữa 2 code, tất cả đều bình thường Thắng à!
Hết hồn (nhưng mọi thứ.. còn nguyên)
----------------------------------------

quocphuoc88 đã viết:
máy e dòng này

Thì nén ra file rỗng
nhưng nếu:

Thì mở ra có file vừa chọn nằm trong đó
Máy e Win 8+ ofice 2013 ( 32 bit )

Lúc nén ra file rổng bạn nhận được thông báo lỗi gì?

Kiều Mạnh · 24/9/15

quocphuoc88 đã viết:
máy e dòng này

Thì nén ra file rỗng
nhưng nếu:

Thì mở ra có file vừa chọn nằm trong đó
Máy e Win 8+ ofice 2013 ( 32 bit )

Mới thử máy mình cũng Y trang như vậy (Win7+Office2010(32))

doveandrose · 24/9/15

máy tôi hàm

Mã:

.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])

chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy

Mã:

Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists(sFile) Then
    sFolder = FSO.GetFile(sFile).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function

quocphuoc88 · 24/9/15

ndu96081631 đã viết:
Lúc nén ra file rổng bạn nhận được thông báo lỗi gì?

Dạ không nhận được lỗi gì hết a. Tất cả chạy trơn tru !

Kiều Mạnh · 24/9/15

doveandrose đã viết:

máy tôi hàm

Mã:

.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])

chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy

Mã:

Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists(sFile) Then
    sFolder = FSO.GetFile(sFile).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function

Mới thử thấy nén File tốt không tao thành File *.zip Rỗng ...nếu thay đổi 2 dòng sau cũng OK

PHP:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(sFile)

Thành như sau cũng OK

PHP:

.Namespace(ZipFilePath).CopyHere FilePath

ndu96081631 · 24/9/15

doveandrose đã viết:

máy tôi hàm

Mã:

.Namespace(sFolder).Items.Item([B][SIZE=3][COLOR=#ff0000]sFile[/COLOR][/SIZE][/B])

chỉ nhận kiểu Variant và là 1 file ShortName chứ hổng đươc fullName
nên code của thầy NDU chỉ có thể viết lại vậy

Mã:

Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#b22222][SIZE=3][B]sFile[/B][/SIZE][/COLOR]
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists(sFile) Then
    sFolder = FSO.GetFile(sFile).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
[COLOR=#ff0000][SIZE=3][B]    sFile = sName[/B][/SIZE][/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000][SIZE=3][B]sFile[/B][/SIZE][/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function

Chỗ này là mình sơ sót, ở trong Items.Item(...) phải là 1 name chứ không thể fullname
Đã vậy thì bỏ luôn sFile cho rồi (hoặc bỏ sName chứ ai lại sFile = sName)

doveandrose · 24/9/15

kieu manh đã viết:
Mới thử thấy nén File tốt không tao thành File *.zip Rỗng ...nếu thay đổi 2 dòng sau cũng OK

PHP:

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(sFile)

Thành như sau cũng OK

PHP:

.Namespace(ZipFilePath).CopyHere FilePath

tôi phải cố gắng làm sao cho hàm

Mã:

.Namespace(sFolder).Items.Item(sFile)

phải chạy được vì tôi biết các bài tới sẽ phải dùng đến nó chứ không dùng cái dưới này được

Mã:

.Namespace(ZipFilePath).CopyHere FilePath

quocphuoc88 · 24/9/15

Nếu

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(FilePath)

E thay thành

.Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item(Tenfile)

Thì nó tạo ra file nén không rỗng !

doveandrose · 24/9/15

ndu96081631 đã viết:
Chỗ này là mình sơ sót, ở trong Items.Item(...) phải là 1 name chứ không thể fullname
Đã vậy thì bỏ luôn sFile cho rồi (hoặc bỏ sName chứ ai lại sFile = sName)

thì ai biết thầy muốn đem thằng sName gả cho ai khác nữa . "cây ổi" nhà thầy mà

ndu96081631 · 24/9/15

doveandrose đã viết:
thì ai biết thầy muốn đem thằng sName gả cho ai khác nữa . "cây ổi" nhà thầy mà

OK!
Vậy chúng ta cùng test theo hàm vừa sửa nhé:

Mã:

Function FileToZip(ByVal FilePath) As Boolean
  'Microsoft Shell Controls And Automation
  Dim FSO As Object
  Dim ZipFilePath, sFolder, sName, [COLOR=#ff0000]sFile[/COLOR]
  On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  sFile = CStr(FilePath)
  If FSO.FileExists([COLOR=#ff0000]CStr(sFile)[/COLOR]) Then
    sFolder = FSO.GetFile([COLOR=#ff0000]CStr(sFile)[/COLOR]).ParentFolder.Path
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = FSO.GetFile(sFile).Name
    [COLOR=#ff0000]sFile = sName[/COLOR]
    If InStr(1, sName, ".") Then
      sName = Left$(sName, InStrRev(sName, "."))
      sName = sName & "zip"
      ZipFilePath = CreateNewZip(sFolder & sName)
      With CreateObject("Shell.Application")
        .Namespace(ZipFilePath).CopyHere .Namespace(sFolder).Items.Item([COLOR=#ff0000]sFile[/COLOR])
      End With
      FileToZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
    End If
  End If
End Function

Xem thử còn lỗi gì nữa không?

quocphuoc88 · 24/9/15

Máy e trơn tru . Tạo file nén KHÔNG RỖNG !

doveandrose · 24/9/15

quocphuoc88 đã viết:
Máy e trơn tru . Tạo file nén KHÔNG RỖNG !

trơn quá té bạn ơi . bạn nén file 200Mb thử xem chữ "Done" xuất hiện khi nào . hi hi

Kiều Mạnh · 24/9/15

doveandrose đã viết:
trơn quá té bạn ơi . bạn nén file 200Mb thử xem chữ "Done" xuất hiện khi nào . hi hi

định làm khó sao .... }}}}}

...càng về cuối càng hay đây

doveandrose · 24/9/15

kieu manh đã viết:
định làm khó sao .......càng về cuối càng hay đây

em làm sao dám giỡn mặt với quần hùng . ai nén file vài trăm MB là thấy rồi . ca này vui nè : làm sao tắt bảng thông báo đang nén mặc định của Hệ điều hành đây ........

ndu96081631 · 24/9/15

doveandrose đã viết:
trơn quá té bạn ơi . bạn nén file 200Mb thử xem chữ "Done" xuất hiện khi nào . hi hi

Cái vụ đó bỏ qua! Bởi mục đích chính của ta hoàn toàn không phải muốn thay thể chương trình WinRAR hay WinZIP. Điều ta cần cuối cùng là EDIT FILE XML NẰM TRONG FILE XLSX, XLSM

Kiều Mạnh · 24/9/15

doveandrose đã viết:
em làm sao dám giỡn mặt với quần hùng . ai nén file vài trăm MB là thấy rồi . ca này vui nè : làm sao tắt bảng thông báo đang nén mặc định của Hệ điều hành đây ........

Mới thử thấy hình sau
File 1,557,618KB chạy tốt nhưng hơi chậm thôi

doveandrose · 24/9/15

ndu96081631 đã viết:
Cái vụ đó bỏ qua! Bởi mục đích chính của ta hoàn toàn không phải muốn thay thể chương trình WinRAR hay WinZIP. Điều ta cần cuối cùng là EDIT FILE XML NẰM TRONG FILE XLSX, XLSM

vâng có lẽ em đi lạc đề rồi . Thầy định hướng lại đi . sau đây chúng ta sẽ làm gì ?

leonguyenz · 24/9/15

ndu96081631 đã viết:
Đây là "công trình" đầu tiên của việc nén file:

Mã:

Dim [COLOR=#ff0000]ZipFilePath, sFolder, sName[/COLOR], sFile As String

..
Mời test thử và cùng hoàn thiện
Lưu ý quan trọng(mất công các bạn tự làm bị lỗi mà không biết): Mấy cái biến màu đỏ tuy ta có thể dùng như chuỗi nhưng tuyệt đối không được khai báo nó dạng chuỗi (kiểu như Dim FilePath as String)... nếu không code lập tức báo lỗi. Các bạn có thể thay đổi 1 vài biến màu đỏ thành dạng As String và test thử

sName As String vẫn chạy bình thường thầy ạ (tại không thấy ai phản hồi cái này).
Windows 7, Excel 2007

ndu96081631 · 24/9/15

doveandrose đã viết:
sau đây chúng ta sẽ làm gì ?

Như chủ đề topic, ta đã nén được rồi thì giờ tiên hành giải nén
(tuy nhiên các bạn khác cứ test thử code bài 61 xem còn lỗi gì không đã)

doveandrose · 24/9/15

leonguyenz đã viết:
sName As String vẫn chạy bình thường thầy ạ (tại không thấy ai phản hồi cái này).
Windows 7, Excel 2007

thì vẫn chạy bình thường là đúng rồi . vì đâu có lệnh nào là .Namespace(sName) ở trong bài đâu . hi hi

ndu96081631 · 24/9/15

Anh Chim Hồng và các bạn khác làm tiếp công đoạn giải nén xem nào
(viết hoài mệt quá)

Kiều Mạnh · 24/9/15

ndu96081631 đã viết:
Anh Chim Hồng và các bạn khác làm tiếp công đoạn giải nén xem nào
(viết hoài mệt quá)

nén và Giải nén OK..........Tuyệt

doveandrose · 24/9/15

bị nêu đích danh ngại quá

Mã:

Public Function UnZip(ByVal ZipFilePath, Optional ByVal ZipToFd) As Boolean
Dim FSO As Object
On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If FSO.FileExists(ZipFilePath) Then
    If IsMissing(ZipToFd) Then ZipToFd = FSO.GetFile(ZipFilePath).ParentFolder.Path
      With CreateObject("Shell.Application")
        .Namespace(ZipToFd).CopyHere .Namespace(ZipFilePath).Items
      End With
      UnZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

Mã:

Sub TestZipFile()
  Dim bRet As Boolean
  Dim vFile
  vFile = Application.GetOpenFilename("All Files, *.zip")
  If TypeName(vFile) = "String" Then
    bRet = UnZip(vFile, "d:\")
    If bRet Then MsgBox "Done!"
  End If
End Sub

ndu96081631 · 24/9/15

doveandrose đã viết:

bị nêu đích danh ngại quá

Mã:

Public Function UnZip(ByVal ZipFilePath, Optional ByVal ZipToFd) As Boolean
Dim FSO As Object
On Error GoTo ErrHandler
  Set FSO = CreateObject("Scripting.FileSystemObject")
  If FSO.FileExists(ZipFilePath) Then
    If IsMissing(ZipToFd) Then ZipToFd = FSO.GetFile(ZipFilePath).ParentFolder.Path
      With CreateObject("Shell.Application")
        .Namespace(ZipToFd).CopyHere .Namespace(ZipFilePath).Items
      End With
      UnZip = (Err.Number = 0)
      Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

Mã:

Sub TestZipFile()
  Dim bRet As Boolean
  Dim vFile
  vFile = Application.GetOpenFilename("All Files, *.zip")
  If TypeName(vFile) = "String" Then
    bRet = UnZip(vFile, "d:\")
    If bRet Then MsgBox "Done!"
  End If
End Sub

Theo tiêu chí mà ta đang hướng tới thì code cần hoàn thiện là:
- Code có khả năng nén 1 file vào trong 1 file zip có sẵn (nếu file zip chưa có thì mới tạo NewZip)
- Code có khả năng giải nén 1 file chỉ định nào đó bên trong file zip đang chứa nhiều files khác (có thể ta chỉ cần edit 1 file nào đó trong file zip mà thôi)

doveandrose · 24/9/15

hi hi . nhưng mà cơm nước cái đã . tí nữa mà chưa có ai làm thì em lại tiếp tục vậy :-=

ndu96081631 · 24/9/15

doveandrose đã viết:
hi hi . nhưng mà cơm nước cái đã . tí nữa mà chưa có ai làm thì em lại tiếp tục vậy

Cơm xong uống nước lọc thôi, đừng uống nước cái ---> "bay" hổng nỗi luôn đóa --=0

doveandrose · 24/9/15

ndu96081631 đã viết:
Theo tiêu chí mà ta đang hướng tới thì code cần hoàn thiện là:
- Code có khả năng nén 1 file vào trong 1 file zip có sẵn (nếu file zip chưa có thì mới tạo NewZip)
- Code có khả năng giải nén 1 file chỉ định nào đó bên trong file zip đang chứa nhiều files khác (có thể ta chỉ cần edit 1 file nào đó trong file zip mà thôi)

rồi chúng ta tiếp tục . bây giờ làm câu 1 trước

Mã:

Function FileToZip(ByVal FilePath, Optional ByVal ZipTo, Optional ByVal seekPath) As Boolean
  'ZipTo : Full Name of Existing Zip file
  'seekPath : path in Existing Zip file
  Dim fso As Object, sFolder, sName, sFile
  On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(FilePath) Then
    sFolder = fso.getfile(FilePath).ParentFolder
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = fso.GetBaseName(FilePath)
    sFile = fso.GetFileName(FilePath)
    If IsMissing(ZipTo) Then ZipTo = CreateNewZip(sFolder & sName & ".zip")
    If Not fso.FileExists(ZipTo) Then ZipTo = CreateNewZip(sFolder & sName & ".zip")
    If Not IsMissing(seekPath) Then ZipTo = ZipTo & "\" & seekPath
    With CreateObject("Shell.Application")
      .Namespace(ZipTo).Copyhere .Namespace(sFolder).items.Item(sFile)
    End With
    FileToZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

ndu96081631 · 24/9/15

doveandrose đã viết:
r
khi dialogfile mở lên nhớ chọn file excel thôi nhé

Kết quả test:
- Chạy lần đầu, chọn file b1.xlsx nó ra kết quả b1.xlsx nằm trong b1.zip
- Chạy lần hai, vẫn chọn file b1.xlsx nó ra kết quả b1.xlsx nằm trong b1.xlsx.zip
Trong khi câu lệnh của ta là:

Mã:

bRet = FileToZip(vFile, [COLOR=#ff0000]ThisWorkbook.Path & "\b1.xlsx.zip"[/COLOR])

Đã chỉ rõ nơi đến thì lần đầu chạy hay lần hai cũng phải cho cùng kết quả chứ nhỉ?

doveandrose · 24/9/15

ndu96081631 đã viết:
Kết quả test:
- Chạy lần đầu, chọn file b1.xlsx nó ra kết quả b1.xlsx nằm trong b1.zip
- Chạy lần hai, vẫn chọn file b1.xlsx nó ra kết quả b1.xlsx nằm trong b1.xlsx.zip
Trong khi câu lệnh của ta là:

Mã:

bRet = FileToZip(vFile, [COLOR=#ff0000]ThisWorkbook.Path & "\b1.xlsx.zip"[/COLOR])

Đã chỉ rõ nơi đến thì lần đầu chạy hay lần hai cũng phải cho cùng kết quả chứ nhỉ?

cho thử sức cái nữa . hi hi

Mã:

Function FileToZip(ByVal FilePath, Optional ByVal ZipTo, Optional ByVal seekPath) As Boolean
  'ZipTo : Full Name of Existing Zip file
  'path in Existing Zip file
  Dim fso As Object, sFolder, sName, sFile
  On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(FilePath) Then
    sFolder = fso.getfile(FilePath).ParentFolder
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = fso.GetBaseName(FilePath)
    sFile = fso.GetFileName(FilePath)
    If IsMissing(ZipTo) Then ZipTo = CreateNewZip(sFolder & sName & ".zip")
    If Not fso.FileExists(ZipTo) Then ZipTo = CreateNewZip(ZipTo)
    If Not IsMissing(seekPath) Then ZipTo = ZipTo & "\" & seekPath
    With CreateObject("Shell.Application")
      .Namespace(ZipTo).Copyhere .Namespace(sFolder).items.Item(sFile)
    End With
    FileToZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

ndu96081631 · 24/9/15

doveandrose đã viết:

cho thử sức cái nữa . hi hi

Mã:

Function FileToZip(ByVal FilePath, Optional ByVal ZipTo, Optional ByVal seekPath) As Boolean
  'ZipTo : Full Name of Existing Zip file
  'path in Existing Zip file
  Dim fso As Object, sFolder, sName, sFile
  On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(FilePath) Then
    sFolder = fso.getfile(FilePath).ParentFolder
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = fso.GetBaseName(FilePath)
    sFile = fso.GetFileName(FilePath)
    If IsMissing(ZipTo) Then ZipTo = CreateNewZip(sFolder & sName & ".zip")
    If Not fso.FileExists(ZipTo) Then ZipTo = CreateNewZip(ZipTo)
    If Not IsMissing(seekPath) Then ZipTo = ZipTo & "\" & seekPath
    With CreateObject("Shell.Application")
      .Namespace(ZipTo).Copyhere .Namespace(sFolder).items.Item(sFile)
    End With
    FileToZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

Mới thử sơ qua ---> Kết quả ngon
Giờ phải vào ca 3, tối nay nếu rảnh sẽ test tiếp

doveandrose · 24/9/15

ndu96081631 đã viết:
Mới thử sơ qua ---> Kết quả ngon
Giờ phải vào ca 3, tối nay nếu rảnh sẽ test tiếp

vâng chào "bác Tài" . khi nào "bác Tài" quay lại thì đoàn lại tiếp tục . hi hi

ndu96081631 · 25/9/15

doveandrose đã viết:
vâng chào "bác Tài" . khi nào "bác Tài" quay lại thì đoàn lại tiếp tục . hi hi

Ôi! Dù là "bác Tài" thì cũng có lúc phải nghỉ chứ, vậy sẽ có "bác Tài" khác thay thế hen!
Tuy nhiên, mình chẳng bao giờ nghĩ mình là "bác Tài". Mình chỉ muốn là người truyền cảm hứng để các bạn thấy yêu Excel hơn mà thôi
Rất mong nhiều bạn khác nữa cùng tham gia cuộc chơi
(hãy cứ nghĩ đây là cuộc chơi cho nó đở căng thẳng)

doveandrose · 25/9/15

ồ thầy quay lại rồi . Chúng ta lại tiếp tục nào

doveandrose · 25/9/15

tiếp theo là câu 2 : giải nén file được chỉ định trong 1 file nén

Mã:

Public Function UnZip(ByVal ZipFilePath, Optional ByVal ZipToFd, _
Optional ByVal targetFile, Optional ByVal seekPath) As Boolean
Dim fso As Object
On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(ZipFilePath) Then
    If IsMissing(ZipToFd) Then ZipToFd = fso.getfile(ZipFilePath).ParentFolder
    If Not IsMissing(seekPath) Then ZipFilePath = ZipFilePath & "\" & seekPath
    With CreateObject("Shell.Application")
        If IsMissing(targetFile) Then
            .Namespace(ZipToFd).copyhere .Namespace(ZipFilePath).items
        Else
            .Namespace(ZipToFd).copyhere .Namespace(ZipFilePath).items.Item(targetFile)
        End If
    End With
    UnZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

xin mời thử 4 trường hợp sau đây

Mã:

bRet = UnZip(vFile)
'bRet = UnZip(vFile, , "[Content_Types].xml")
'bRet = UnZip(vFile, , "sheet2.xml", "xl\worksheets")
'bRet = UnZip(vFile, ThisWorkbook.Path & "\Zipto", , "docProps")

ndu96081631 · 25/9/15

doveandrose đã viết:

tiếp theo là câu 2 : giải nén file được chỉ định trong 1 file nén

Mã:

Public Function UnZip(ByVal ZipFilePath, Optional ByVal ZipToFd, _
Optional ByVal targetFile, Optional ByVal seekPath) As Boolean
Dim fso As Object
On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(ZipFilePath) Then
    If IsMissing(ZipToFd) Then ZipToFd = fso.getfile(ZipFilePath).ParentFolder
    If Not IsMissing(seekPath) Then ZipFilePath = ZipFilePath & "\" & seekPath
    With CreateObject("Shell.Application")
        If IsMissing(targetFile) Then
            .Namespace(ZipToFd).copyhere .Namespace(ZipFilePath).items
        Else
            .Namespace(ZipToFd).copyhere .Namespace(ZipFilePath).items.Item(targetFile)
        End If
    End With
    UnZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

xin mời thử 4 trường hợp sau đây

Mã:

bRet = UnZip(vFile)
'bRet = UnZip(vFile, , "[Content_Types].xml")
'bRet = UnZip(vFile, , "sheet2.xml", "xl\worksheets")
'bRet = UnZip(vFile, ThisWorkbook.Path & "\Zipto", , "docProps")

Tôi đoán rằng code ở bài 80 và 86 có thể không cần đối số seekPath
Thử xem liệu có được không?
Tốt nhất làm sao cả 2 hàm chỉ cần 2 đối số: Nguồn và Đích

doveandrose · 25/9/15

ndu96081631 đã viết:
Tôi đoán rằng code ở bài 80 và 86 có thể không cần đối số seekPath
Thử xem liệu có được không?
Tốt nhất làm sao cả 2 hàm chỉ cần 2 đối số: Nguồn và Đích

vâng vậy thầy hướng dẫn đoạn code cho tụi em học với

ndu96081631 · 25/9/15

doveandrose đã viết:
vâng vậy thầy hướng dẫn đoạn code cho tụi em học với

Lấy thư mục "do choi" của bạn hôm qua làm ví dụ nhé:

Mã:

Sub UnZip()
  Dim path
  path = ThisWorkbook.path
  With CreateObject("Shell.Application")
    .Namespace([COLOR=#ff0000]path[/COLOR]).Copyhere .Namespace([COLOR=#0000cd]path & "\b1.xlsx.zip\xl\"[/COLOR]).items.Item([COLOR=#0000cd]"styles.xml"[/COLOR])
  End With
End Sub

Hoặc vầy:

Mã:

Sub UnZip()
  Dim path
  path = ThisWorkbook.path
  With CreateObject("Shell.Application")
    .Namespace([COLOR=#ff0000]path[/COLOR]).Copyhere .Namespace([COLOR=#0000cd]path & "\b1.xlsx.zip\"[/COLOR]).items.Item([COLOR=#0000cd]"xl\styles.xml"[/COLOR])
  End With
End Sub

đều được!
Màu xanh là nguồn, màu đỏ là đích
Thử xem được không

doveandrose · 25/9/15

màu xanh là nguồn nhưng mà nguồn này được đặt vào 2 vị trí khác nhau + thêm màu đỏ nữa thành ra 3 vị trí . mà thầy biểu dùng 2 tham số đầu vào thì khó quá . nên mới cần thầy múa vài đường cho tụi em học

Cá ngừ F1 · 25/9/15

ndu96081631 đã viết:
Ôi! Dù là "bác Tài" thì cũng có lúc phải nghỉ chứ, vậy sẽ có "bác Tài" khác thay thế hen!
Tuy nhiên, mình chẳng bao giờ nghĩ mình là "bác Tài". Mình chỉ muốn là người truyền cảm hứng để các bạn thấy yêu Excel hơn mà thôi
Rất mong nhiều bạn khác nữa cùng tham gia cuộc chơi
(hãy cứ nghĩ đây là cuộc chơi cho nó đở căng thẳng)

N ĐÚ luôn luôn là người truyền cảm hứng cho anh em GPE học hỏi. }}}}}

Tuy nhiên, em chưa hiểu ứng dụng của Topic này là gì (chắc bị V Ba cho tầu hỏa nhập ma rồi +-+-+-+

)

ndu96081631 · 25/9/15

Cá ngừ F1 đã viết:
Tuy nhiên, em chưa hiểu ứng dụng của Topic này là gì

Chú này! Nói cả đống bài trong topic này rồi còn gì (về mục đích)
Chắc chưa đọc hết?

ndu96081631 · 25/9/15

doveandrose đã viết:
màu xanh là nguồn nhưng mà nguồn này được đặt vào 2 vị trí khác nhau + thêm màu đỏ nữa thành ra 3 vị trí . mà thầy biểu dùng 2 tham số đầu vào thì khó quá . nên mới cần thầy múa vài đường cho tụi em học

Thì 2 cái màu xanh ráp lại là thành nguồn (khi dùng ta chỉ cần truyền vào path & "\b1.xlsx.zip\xl\styles.xml" là được rồi)
Việc của ta là "cắt" sao đó để phân cái nguồn này thành 2 để ráp code thôi
Mới "ý tưởng" thôi (vì thí nghiệm thấy được), lấy gì "múa" đây

doveandrose · 25/9/15

ndu96081631 đã viết:
Thì 2 cái màu xanh ráp lại là thành nguồn (khi dùng ta chỉ cần truyền vào path & "\b1.xlsx.zip\xl\styles.xml" là được rồi)
Việc của ta là "cắt" sao đó để phân cái nguồn này thành 2 để ráp code thôi
Mới "ý tưởng" thôi (vì thí nghiệm thấy được), lấy gì "múa" đây

dạ em cũng ương lắm . em biết nếu gắn chung lại rồi vào trong hàm muốn phân chia ra thì phải biết chuỗi truyền vào là 1 folder hay 1 file . nhưng mà thích ngắm thầy ra chiêu cơ . hi hi

ndu96081631 · 25/9/15

doveandrose đã viết:
dạ em cũng ương lắm . em biết nếu gắn chung lại rồi vào trong hàm muốn phân chia ra thì phải biết chuỗi truyền vào là 1 folder hay 1 file . nhưng mà thích ngắm thầy ra chiêu cơ . hi hi

Tôi cũng có nghĩ đến chuyện này rồi (cũng chỉ ý tưởng): Ta viết luôn 2 dòng:

Mã:

.Namespace(ZipTo).Copyhere .Namespace(sFolder).items.Item(sFile)
.Namespace(ZipTo).Copyhere .Namespace(sFolder & "\" & sFile).items

Nếu không được thằng trên thì nhảy xuống thằng dưới
Chẳng biết nữa, phải thử rồi tính
(nói chung lúc code mình có thể cực chút, miễn sao lúc dùng thoải mái nhất là ngon! Nhiều đối số truyền quá rất khó hình dung)

doveandrose · 25/9/15

theo ý thầy , em sửa lại

Mã:

Function FileToZip(ByVal FilePath, Optional ByVal ZipTo) As Boolean
  Dim fso As Object, sFolder, sName, sFile
  On Error GoTo ErrHandler
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.fileexists(FilePath) Then
    sFolder = fso.getfile(FilePath).ParentFolder
    If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    sName = fso.GetBaseName(FilePath)
    sFile = fso.GetFileName(FilePath)
    If IsMissing(ZipTo) Then ZipTo = CreateNewZip(sFolder & sName & ".zip")
    With CreateObject("Shell.Application")
        If Not fso.fileexists(ZipTo) And Right(ZipTo, 4) = ".zip" Then ZipTo = CreateNewZip(ZipTo)
        .Namespace(ZipTo).copyhere .Namespace(sFolder).items.Item(sFile)
    End With
    FileToZip = (Err.Number = 0)
    Exit Function
ErrHandler:     MsgBox Err.Description
  End If
End Function

Mã:

Public Function UnZip(ByVal ZipFilePath, Optional ByVal ZipToFd) As Boolean
Dim fso As Object, lPos As Long
On Error GoTo ErrHandler
Set fso = CreateObject("Scripting.FileSystemObject")
If IsMissing(ZipToFd) Then ZipToFd = ThisWorkbook.Path
With CreateObject("Shell.Application")
    If Right(ZipFilePath, 1) = "\" Then ZipFilePath = Left(ZipFilePath, Len(ZipFilePath) - 1)
    If fso.fileexists(ZipFilePath) Then
        .Namespace(ZipToFd).copyhere .Namespace(ZipFilePath).items
    Else
        lPos = InStrRev(ZipFilePath, "\")
        If lPos > 0 Then .Namespace(ZipToFd).copyhere ( _
        .Namespace(Left(ZipFilePath, lPos)).items.Item(Mid(ZipFilePath, lPos + 1)))
    End If
End With
UnZip = (Err.Number = 0)
Exit Function
ErrHandler:     MsgBox Err.Description
End Function

thử nghiệm

Mã:

Sub TestZipFile()
  Dim bRet As Boolean, vFile
  'vFile = Application.GetOpenFilename("All Files, *.*")
  vFile = Application.GetOpenFilename("All Files, *.zip")
  If TypeName(vFile) = "String" Then
    'bRet = FileToZip(vFile)
    'bRet = FileToZip(vFile, ThisWorkbook.Path & "\b1.xlsx.zip")
    'bRet = FileToZip(vFile, ThisWorkbook.Path & "\b1.xlsx.zip\xl")
    
    'bRet = UnZip(vFile)
    'bRet = UnZip(vFile & "\[Content_Types].xml")
    bRet = UnZip(vFile & "\xl")
    If bRet Then MsgBox "Done!"
  End If
End Sub

ndu96081631 · 26/9/15

doveandrose đã viết:
theo ý thầy , em sửa lại

Cách test hữu hiệu nhất là đưa vào thực nghiệm
Tôi đã viết xong thủ tục xóa styles rác từ đường dẫn file styles.xml cho trước:

Mã:

Sub ClearStylesFromXML(ByVal xmlFile As String)
  Dim Params As String, filename As String, StartDir As String, ext As String
  Dim text1 As String, text2 As String, text3 As String
  Dim Arr, aBuiltInYes(), aBuiltInNo()
  Dim lBuiltInYes As Long, lBuiltInNo As Long, i As Long, lPos_Start As Long, lPos_End As Long
  Dim FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  'On Error Resume Next
  With FSO
    If Not .FileExists(xmlFile) Then Exit Sub
    If .GetFile(xmlFile).Name <> "styles.xml" Then Exit Sub
    With .OpenTextFile(xmlFile)
      text1 = .ReadAll
      .Close
    End With
    lPos_Start = InStr(1, text1, "<cellStyle name=")
    lPos_End = InStr(1, text1, "</cellStyles>")
    text2 = Mid(text1, lPos_Start, lPos_End - lPos_Start)
    text3 = Replace(text2, "/><", "/>" & vbLf & "<")
    Arr = Split(text3, vbLf)
    For i = LBound(Arr) To UBound(Arr)
      If InStr(1, Arr(i), "builtinId") Then
        lBuiltInYes = lBuiltInYes + 1
        ReDim Preserve aBuiltInYes(1 To lBuiltInYes)
        aBuiltInYes(lBuiltInYes) = Arr(i)
      Else
        lBuiltInNo = lBuiltInNo + 1
        ReDim Preserve aBuiltInNo(1 To lBuiltInNo)
        aBuiltInNo(lBuiltInNo) = Arr(i)
      End If
    Next
    If lBuiltInNo Then
      text1 = Replace(text1, text2, Join(aBuiltInYes, ""))
      .CreateTextFile(xmlFile, True).Write text1
       MsgBox "Da xoa xong " & lBuiltInNo & " styles rác"
    Else
      MsgBox "Không có styles rác nào"
    End If
  End With
End Sub

Các bạn có thể sửa thủ tục trên thành hàm để trả về giá trị gì đó nếu cần
------------------------------------
Giờ bắt đầu thử nghiệm:
- Đầu tiên ta sẽ tìm đâu đó một file có nhiều styles rác (trên diễn đàn có đầy). Tiếp theo nếu file chứa styles rác này có định dạng .xls thì hãy mở file SaveAs thành .xlsx (hoặc .xlsm), sau đó bắt đầu viết thêm 1 code làm việc theo quy trình 5 bước sau:
1> Đổi đuôi file .xlsx (hoặc xlsm) thành .xlsx.zip (hoặc .xlsm.zip)
2> Dùng hàm giải nén file .xlsx.zip (hoặc .xlsm.zip) để lấy ra file styles.xml
3> Dùng code tôi viết ở trên để làm sạch style rác
4> Dùng hàm nén file để đưa file styles.xml vào lại trong file .xlsx.zip (hoặc .xlsm.zip)
5> Đổi đuôi file .xlsx.zip (hoặc .xlsm.zip) trở lại thành .xlsx (hoặc .xlsm)
- Mở bằng tay file .xlsx (hoặc .xlsm) kiểm tra xem các styles rác đã thật sự được làm sạch hay chưa?
------------------------------------
Lưu ý quan trọng: Từ bước 2 đến bước 3 có khả năng xảy ra lỗi. Lý do vì quá trình giải nén tại bước 2, file styles.xml chưa kịp hình thành nên không thể xử lý xóa styles tại bước 3. Vậy bằng cách nào đó ta hãy làm trễ bước 2 khoảng 1 vài giây rồi hẳn tiếp bước 3 (Dùng Application.Wait chẳng hạn)
Nói chung mọi thứ đã có, giờ hãy thí nghiệm để kiểm chứng thành quả nhé
Cảm ơn!

doveandrose · 26/9/15

ẹc thầy làm vậy em bị sốc thầy ơi
thầy có thể giải thích sơ qua về cấu trúc file styles.xml được không ạ ?

ndu96081631 · 26/9/15

doveandrose đã viết:
ẹc thầy làm vậy em bị sốc thầy ơi
thầy có thể giải thích sơ qua về cấu trúc file styles.xml được không ạ ?

Mở file styles.xml bằng Notepad là thấy chứ cần gì giải thích
- Tìm trong styles.xml những chuỗi dạng <cellStyle name="Tên của style" ........./>
- Nếu thấy từ khóa builtinId bên trong <cellStyle name="Tên của style"...... builtinId... /> thì đó là style có sẵn
- Nếu không tìm thấy từ khóa builtinId thì đó là style rác và ta sẽ xóa nó

ndu96081631 · 26/9/15

Nói thêm: Ở đây ta mượn tạm sub xóa styles để test mấy công cụ nén và giải nén. Nếu nó hoạt động tốt thì ta xem như công cụ của ta tốt
Đương nhiên, việc edit styles bên trong file styles.xml các bạn có thể viết kiểu khác tùy ý

doveandrose · 26/9/15

ndu96081631 đã viết:
Mở file styles.xml bằng Notepad là thấy chứ cần gì giải thích
- Tìm trong styles.xml những chuỗi dạng <cellStyle name="Tên của style" ........./>
- Nếu thấy từ khóa builtinId bên trong <cellStyle name="Tên của style"...... builtinId... /> thì đó là style có sẵn
- Nếu không tìm thấy từ khóa builtinId thì đó là style rác và ta sẽ xóa nó

thầy nói vậy may ra em mới hiểu cần phải làm gì
tí nữa rảnh em viết lại code thực hiện hết 5 bước của thầy luôn

doveandrose · 26/9/15

báo cáo thầy là code hàm FileToZip của em làm tan xác luôn file Zip . Nhờ thầy cứu với
trong đây có file excel 500kb có 2 style rác . chạy code xong gán file style.xml lại file zip là đi đời luôn file zip

Kiều Mạnh · 26/9/15

doveandrose đã viết:
báo cáo thầy là code hàm FileToZip của em làm tan xác luôn file Zip . Nhờ thầy cứu với
trong đây có file excel 500kb có 2 style rác . chạy code xong gán file style.xml lại file zip là đi đời luôn file zip

Mình mới thử thấy file Zip ok mà

Vọc chơi với những thuật toán nén và giải nén file (1 người xem)

Người dùng đang xem chủ đề này

Huyền thoại GPE

Thành viên hoạt động

I don't program, I beat code into submission!!!

Thành viên gạo cội

Huyền thoại GPE

hello

Huyền thoại GPE

hello

Huyền thoại GPE

hello

Huyền thoại GPE

Thành viên gạo cội

hello

Huyền thoại GPE

Huyền thoại GPE

I don't program, I beat code into submission!!!

hello

Huyền thoại GPE

I don't program, I beat code into submission!!!

Huyền thoại GPE

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

hello

Thành viên gạo cội

I don't program, I beat code into submission!!!

Thành viên thường trực

Thành viên gạo cội

I don't program, I beat code into submission!!!

File đính kèm

I don't program, I beat code into submission!!!

Huyền thoại GPE

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

hello

hello

Huyền thoại GPE

hello

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Chuyên gia GPE

I don't program, I beat code into submission!!!

hello

Huyền thoại GPE

hello

Huyền thoại GPE

Chuyên gia GPE

Thành viên thường trực

Thành viên thường trực

Huyền thoại GPE

I don't program, I beat code into submission!!!

hello

Thành viên thường trực

I don't program, I beat code into submission!!!

Huyền thoại GPE

hello

Thành viên thường trực

hello

Huyền thoại GPE

File đính kèm

Thành viên thường trực

hello

I don't program, I beat code into submission!!!

hello

Huyền thoại GPE

I don't program, I beat code into submission!!!

File đính kèm

hello

Thành viên gạo cội

Huyền thoại GPE

hello

Huyền thoại GPE

I don't program, I beat code into submission!!!