flask

§â¹Ï¤ù°µ¤G­È¤Æ³B²z,ÁÙ¬O«Ü¦h½u±øµLªk²M°£,¨C¦¸¦rªº¦ì¸m¤]¤£©w,¥\¤O¤Ó²L¨S¿ìªk.


Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_DIB = 8

Sub ÅçÃÒ¹Ï()
    Dim img
    Dim CtrlRange
    Dim bytClipData() As Byte
    Dim arr() As String
    Dim ts As Integer
   
    Cells.Clear
    Cells.Font.Size = 4
    Cells.RowHeight = 6
    Cells.ColumnWidth = 0.6
    Cells.Font.Bold = True
    On Error Resume Next
    With CreateObject("InternetExplorer.application")
        .Visible = True
        .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        
        Set img = .Document.all.tags("img")(1)
        Set CtrlRange = .Document.body.createControlRange()
        CtrlRange.Add img
        CtrlRange.execCommand "Copy", True

        Dim hMem As Long, lpData As Long
        OpenClipboard 0&
        hMem = GetClipboardData(8)
        
        If CBool(hMem) Then
            lpData = GlobalLock(hMem)
            lClipSize = GlobalSize(hMem)
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1)
                CopyMemory bytClipData(0), ByVal lpData, lClipSize
            End If
            GlobalUnlock hMem
        End If
        CloseClipboard
'        For i = 0 To UBound(bytClipData)
'        Cells(i + 1, 1) = bytClipData(i)
'    Next i
    'Erase arr()
        a1 = bytClipData(0)
        a2 = bytClipData(4)
        a3 = bytClipData(8)
        a4 = lClipSize - a1
        a5 = a4 / a2 / a3

        If a5 < 3 Then
            a1 = lClipSize - a2 * a3
            a5 = 1
        Else
            a5 = Int(a5)
        End If
        ReDim arr(1 To a2 * a3)
        For i = 1 To a2 * a3
            arr(i) = ""
            ts = 0
            'For j = 0 To a5 - 1
            '    ts = ts + Val(bytClipData((i - 1) * a5 + a1 + 2))
            'Next j
            'ts = ts / a5
            ts = Val(bytClipData((i - 1) * a5 + a1 + 2))
            If ts > 220 Then
                arr(i) = 1
            End If
            'If i / a2 = Int(i / a2) Then a1 = a1 + 0
        Next i
        For i = 2 To a3 - 1
            For j = 2 To a2
                Cells(a3 + 1 - i, j) = arr((i - 1) * a2 + j)
            Next j
        Next i
         For i = 2 To a3
            For j = 2 To a2
                p = 0
                For m = -1 To 1
                    For n = -1 To 1
                        p = p + Cells(i + m, j + n)
                    Next n
                Next m
                If p < 3 Then Cells(i, j) = ""    '²Ä¤@¦¸¥hÂø«H
            Next j
        Next i
        For i = 3 To a3
            For j = 3 To a2
                p = 0
                For m = -2 To 2
                    For n = -2 To 2
                        p = p + Cells(i + m, j + n)
                    Next n
                Next m
                If p < 4 Then Cells(i, j) = ""    '²Ä¤G¦¸¥hÂø«H
            Next j
        Next i
'        temp = ""
'        For i = 2 To a2
'            For j = 2 To a3 - 1
'                Cells(a3 + 1, i) = Cells(a3 + 1, i) + Cells(j, i)
'            Next j
'            If Cells(a3 + 1, i) = 0 Then Cells(a3 + 1, i) = ""
'        Next i
       ' .Quit
    End With
   
        Erase arr()
        Erase bytClipData()
        
End Sub