• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Xóa các tag của source trang web

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Xóa các tag của source trang web

Gửi bàigửi bởi truongphu » T.Hai 23/04/2012 7:14 am

Thủ thuật: Xóa các tag của source trang web
Tác giả: By Herman Liu VB6, by truongphu VBA
Mô tả: By Herman Liu



VB6:
  1. Private Sub cmdStripTags_click()
  2.     On Error Resume Next
  3.     Dim strContent As String, mString As String
  4.     Dim mStartPos As Long, mEndPos As Long
  5.     Dim i, j
  6.     strContent = Text1.Text
  7.        ' Start process
  8.    mStartPos = InStr(strContent, "<")
  9.     mEndPos = InStr(strContent, ">")
  10.     Do While mStartPos <> 0 And mEndPos <> 0 And mEndPos > mStartPos
  11.           mString = Mid(strContent, mStartPos, mEndPos - mStartPos + 1)
  12.           strContent = Replace(strContent, mString, "")
  13.           mStartPos = InStr(strContent, "<")
  14.           mEndPos = InStr(strContent, ">")
  15.     Loop
  16.        ' Translate common escape sequence chars
  17.    strContent = Replace(strContent, "&nbsp;", " ")
  18.     strContent = Replace(strContent, "&amp;", "&")
  19.     strContent = Replace(strContent, "&quot;", "'")
  20.     strContent = Replace(strContent, "&#", "#")
  21.     strContent = Replace(strContent, "&lt;", "<")
  22.     strContent = Replace(strContent, "&gt;", ">")
  23.     strContent = Replace(strContent, "%20", " ")
  24.     strContent = LTrim(Trim(strContent))
  25.     Do While Left(strContent, 1) = Chr$(13) Or Left(strContent, 1) = Chr$(10)
  26.           strContent = Mid(strContent, 2)
  27.     Loop
  28.     Text1.Text = strContent
  29.        ' If any angle brackets still exist, highlight the first one
  30.    i = InStr(Text1.Text, "<")
  31.     j = InStr(Text1.Text, ">")
  32.     If j < i And j > 0 Then i = j
  33.     If i > 0 Then
  34.           Text1.SelStart = i - 1
  35.           Text1.SelLength = 1
  36.     ElseIf j > 0 Then
  37.           Text1.SelStart = j - 1
  38.           Text1.SelLength = 1
  39.     End If
  40.     Text1.SetFocus
  41. End Sub
  42.  


VBA:
  1. Private Sub Command1_Click()
  2. On Error Resume Next
  3. Dim objWord As Object ' code by truongphu
  4. Set objWord = CreateObject("Word.Application")
  5. objWord.Documents.Add
  6. objWord.Selection.Text = Text1.Text
  7. objWord.Selection.Find.ClearFormatting
  8.     With objWord.Selection.Find
  9.         .MatchWildcards = True
  10.         .Text = "\<*\>"
  11.         .Replacement.Text = ""
  12.         .Wrap = 1 'wdFindContinue
  13.    End With
  14. objWord.Selection.Find.Execute Replace:=2 'wdReplaceAll
  15. objWord.Selection.WholeStory
  16. Text1.Text = objWord.Selection
  17. objWord.quit False: Set objWord = Nothing
  18. End Sub
Tập tin đính kèm
Tách các the Tag StripTags.rar
(3.31 KiB) Đã tải 366 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Quay về “[VB] Chuỗi và Thời gian”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách