返回列表 上一主題 發帖

如何實現比較圖

回復 1# play9091
試試看是這樣嗎?


圖表.rar (30.88 KB)

TOP

回復 4# play9091
不好意思 沒2010版  不知如何解答 ,修改程式碼試試看
  1. Option Explicit
  2. '***** 刪掉這些
  3. Private Type TGUID
  4.   Data1 As Long
  5.   Data2 As Integer
  6.   Data3 As Integer
  7.   Data4(0 To 7) As Byte
  8. End Type
  9. Private Declare Function OleLoadPicturePath Lib "oleaut32" ( _
  10.     ByVal szURLorPath As Long, ByVal punkCaller As Long, _
  11.     ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, _
  12.     ByRef riid As TGUID, ByRef ppvRet As IPicture) As Long
  13. '***** 刪掉到理
  14. Dim 網路圖片 As String, 圖片 As String
  15. Private Sub UserForm_Initialize()
  16.     Dim xLen As Integer, E As Worksheet
  17.     '網路圖片 = "http://t1.gstatic.com/images?q=tbn:ANd9GcTW_IhT0LcFWjucAjA_OMOpg4igw4IA2hyKfoJMiMSzyF-fRUERNg"
  18.     '這網路圖片可另行指定 PC上的圖檔
  19.     '網路圖片 = "D:\EX1.GIF"   '你須指定圖檔
  20.     網路圖片 = ""            '或是不指定圖檔
  21.     圖片 = ThisWorkbook.Path & "\圖片.gif"
  22.     With Application
  23.         .Visible = False
  24.         .WindowState = xlMaximized
  25.         Me.Width = .Width - (.Width * 0.06)
  26.         Image1.Width = Me.Width - (.Width * 0.32)
  27.     End With
  28.     With ComboBox1
  29.         For Each E In Sheets
  30.             .AddItem E.Name
  31.             xLen = IIf(xLen > Len(E.Name), xLen, Len(E.Name))
  32.         Next
  33.         .ListWidth = 5 * xLen
  34.     End With
  35.     ListBox1.MultiSelect = fmMultiSelectExtended
  36.     ListBox2.MultiSelect = fmMultiSelectExtended
  37.     Image1.Picture = LoadPicture(網路圖片)
  38. End Sub
  39. '刪掉這函數
  40. Private Function LoadPicture(ByVal strFileName As String) As IPicture
  41.     Dim IID As TGUID
  42.   With IID
  43.     .Data1 = &H7BF80980
  44.     .Data2 = &HBF32
  45.     .Data3 = &H101A
  46.     .Data4(0) = &H8B
  47.     .Data4(1) = &HBB
  48.     .Data4(2) = &H0
  49.     .Data4(3) = &HAA
  50.     .Data4(4) = &H0
  51.     .Data4(5) = &H30
  52.     .Data4(6) = &HC
  53.     .Data4(7) = &HAB
  54.   End With
  55.   On Error GoTo ERR_LINE
  56.   OleLoadPicturePath StrPtr(strFileName), 0&, 0&, 0&, IID, LoadPicture
  57.   If LoadPicture Is Nothing Then GoTo ERR_LINE
  58.   Exit Function
  59. ERR_LINE:
  60.   MsgBox "嘗試失敗!"
  61. End Function
  62. '刪掉函數到這裡
複製代碼

TOP

        靜思自在 : 要用心,不要操心、煩心。
返回列表 上一主題