Results 1 to 10 of 565

Thread: Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #11
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10

    White Spam URL WhiteSpamUrl WhiteSpamUrl()

    White Spam URL WhiteSpamUrl WhiteSpamUrl()

    Code:
    Sub WhiteSpamUrl()   '   White Spam URL  WhiteSpamUrl WhiteSpamUrl()  https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222     https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18376&viewfull=1#post18376
    Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
    Dim SelText As String
     Let SelText = Selection.Text
    Dim RwTxt() As String
     Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
    Dim RwCnt As Long
        For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
        Dim ClmTxt() As String
         Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
        Dim ClmCnt As Long
            For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
                If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Then
                Dim URL As String, URL2 As String
                 Let URL = Trim(ClmTxt(ClmCnt))
                 Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
                 Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
                 Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
                Else
                ' no url
                End If
            
            Next ClmCnt
        Next RwCnt
     Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"
    
    '   Put the string in the clipboard
        With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '   web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
         .SetText ClipTxt
         .PutInClipboard
        End With
    End Sub
    Last edited by DocAElstein; 12-24-2023 at 03:40 AM.

Similar Threads

  1. Some Date Notes and Tests
    By DocAElstein in forum Test Area
    Replies: 5
    Last Post: 03-26-2025, 02:56 AM
  2. Replies: 116
    Last Post: 02-23-2025, 12:13 AM
  3. Replies: 21
    Last Post: 12-15-2024, 07:13 PM
  4. Replies: 42
    Last Post: 05-29-2023, 01:19 PM
  5. Replies: 11
    Last Post: 10-13-2013, 10:53 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •