ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

½Ð°Ý§Ú³oVBA­þ¸Ì¦³°ÝÃD¡H¬°¤°»ò·|µLªk¥X²{ 424 µLªk§ä¨ìª«¥ó©O?

½Ð°Ý§Ú³oVBA­þ¸Ì¦³°ÝÃD¡H¬°¤°»ò·|µLªk¥X²{ 424 µLªk§ä¨ìª«¥ó©O?

½Ð°Ý¦U¦ì«e½ú¥ý¶i

¦p¦óÅý³oÀÉ®×       ¯à¦Û°Ê¸õ¥X¦h±i¹Ï¤ù¤Î¹ïÀ³¸ê®Æ)-­^¤åª©-02.rar (341.33 KB)          ¥i¥H¹³¥kÃä³oÀɮ׶}±Ò¹ÏÀÉ©O?    20180611 VBA Ū¨ú¹Ï¤ù v.02.zip (43.52 KB)


     ¥kÃ䪺ÀÉ®× ¹Ï¤ù¦p¤U¡G

3333.jpg
2018-6-12 19:36


½Ð°Ý§Ú³oVBA­þ¸Ì¦³°ÝÃD¡H¬°¤°»ò·|µLªk¥X²{ 424 µLªk§ä¨ìª«¥ó©O?

Private Sub ComboBox1_Change()
Dim a As Range
Application.ScreenUpdating = False
With Database
  Set a = .Columns("E").Find(ComboBox1, lookat:=xlWhole)
  Label1.Caption = a.Offset(, 1)
  a.Offset(, 1).CopyPicture '½Æ»s¦¨¹Ï¤ù   a.Offset(, 1).  1¬°¶Ç¦^¤W1¦æµ{¦¡ a = .Columns("E").«á1®æÀx¦s®æªº¹Ï¤ù
  With .ChartObjects.Add(1, 1, a.Offset(, 2).Width, a.Offset(, 2).Height) '·s¼W¹Ïªí
    .Chart.Paste '¶K¤W¹Ï¤ù
    .Chart.Export "D:\temp.jpg" '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
    .Delete '§R°£¹Ïªí
  End With
  Image1.Picture = LoadPicture("D:\temp.jpg") 'ªí³æÅã¥Ü¹Ï¤ù
  Kill "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
End With
Application.ScreenUpdating = True
End Sub



Private Sub UserForm_Initialize()
Dim a As Range
Set d = CreateObject("Scripting.Dictionary")
With Database
   For Each a In .Range(.[E2], .[E2].End(xlDown))
      d(a.Value) = ""
   Next
End With
ComboBox1.List = d.keys
End Sub


-------------------------------------------------------------------
ÁÂÁ¦U¦ì

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-6-13 08:27 ½s¿è

¦^´_ 1# jeffrey628litw

¸Õ¸Õ¬Ý
  1. Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
  2. Dim D As Object, Sh As Worksheet '¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
  3. Private Sub UserForm_Initialize()
  4.     Dim A As Range, S As String
  5.     Set D = CreateObject("Scripting.Dictionary")
  6.     Set Sh = Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  7.     'With Sheets("Database") ' ©Î¬O With Sheet1
  8.     With Sh
  9.         For Each A In .Range(.[E2], .[E2].End(xlDown))
  10.             '**************************
  11.             'F10 ,F11 ¦³´«¦æ¦r¤¸ »Ý­×§ï
  12.             '¤j ¨¦µ¾¥­
  13.             'Shohei Ohtan
  14.             '***************************
  15.             S = Replace(Trim(A), vbLf, Space(1))  '´«¦æ¦r¤¸ §ï¦¨ Space(1)
  16.             Set D(S) = Range(A.Offset(, 1).Address)
  17.             'Debug.Print S, D(S).Address  '«ü¥O:À˵ø->¤Î®Éµøµ¡¥i¬Ý¬Ý
  18.         Next
  19.     End With
  20.     ComboBox1.List = D.keys
  21.     Label1.WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  22.     With Image1               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  23.         .PictureAlignment = fmPictureAlignmentCenter '2
  24.         .PictureSizeMode = fmPictureSizeModeClip     '0
  25.     End With
  26. End Sub
  27. Private Sub ComboBox1_Change()
  28.     Dim A As Range
  29.     Label1.Caption = "¨S¦³¦¹¹Ï¤ù"
  30.     Image1.Picture = LoadPicture("") '¤£Åã¥Ü¹Ï¤ù
  31.     'Image1.Visible = False      '©Î¬OÁôÂÃ
  32.     If ComboBox1.ListIndex = -1 Then Exit Sub
  33.     If ¹Ï¤ùÀˬd(D(ComboBox1.Value).Address) = False Then Exit Sub
  34.     'Image1.Visible = True      'Åã¥Ü
  35. End Sub
  36. Private Function ¹Ï¤ùÀˬd(xPicture As String) As Boolean
  37.     Dim S As Shape, P As Object, xTop As Double
  38.     For Each S In Sh.Shapes
  39.         '*************************************************
  40.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  41.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  42.             ¹Ï¤ùÀˬd = True
  43.             S.Copy  '¹Ï¤ù½Æ»s
  44.             Set P = S
  45.             Exit For
  46.         End If
  47.         '***************************************************
  48.     Next
  49.     If ¹Ï¤ùÀˬd = True Then
  50.         With Sh
  51.             Label1.Caption = ComboBox1
  52.             With .ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  53.                 .Chart.Paste '¶K¤W¹Ï¤ù
  54.                 .Chart.Export "D:\temp.jpg" '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  55.                 .Delete '§R°£¹Ïªí
  56.             End With
  57.             Image1.Picture = LoadPicture("D:\temp.jpg") 'ªí³æÅã¥Ü¹Ï¤ù
  58.             Kill "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
  59.         End With
  60.     End If
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE


    ÁÂÁ G ¶W¯Åª©¥Dªº¦^ÂСA¥Ø«eµo²{³Ì«á­n¥[ End Function ´N¥i¥HRun¤F¡A¨ä¥LÁÙ¦b¬ã¨s¤¤¡A¶W¯Å·PÁ±zªºÀ°¦£¡C

TOP

¦^´_  jeffrey628litw

¸Õ¸Õ¬Ý
GBKEE µoªí©ó 2018-6-13 08:26



    ½Ð°Ý§Ú·Q­n«öDisplay Photo«ö¶s«á¡A
    ¤U©Ô¿ï³æ Player Name
     ¿ïMchael  Jordan «á¥i¥H¥X²{
      Image1¡G¬°F2¹Ï®×
       Image2¬°F3¹Ï®×

       Ãþ¦üEBAY ¿z¿ï§¹¦³°}¦C¹Ïªí¡AÃþ¦ü¤U¹Ï

4444.jpg
2018-6-13 22:25


Àɮצb¶³ºÝ  http://webhd.xuite.net/_oops/jeffrey628litw/c6x

TOP

¦^´_ 4# jeffrey628litw
¸Õ¸Õ¬Ý
  1. Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
  2. Dim D As Object, Sh(1 To 2) As Worksheet '¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
  3. Dim xTempPicture As String
  4. Private Sub UserForm_Initialize()
  5.     Dim A As Range, S As String
  6.     Set D = CreateObject("Scripting.Dictionary")
  7.     Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  8.     Set Sh(2) = ThisWorkbook.Sheets.Add
  9.     xTempPicture = "D:\IE.jpg"
  10.     ¶×¤J¹Ï¤ù   '¸ü¤Jªí³æµe­±¹Ï¤ù
  11.     With Sh(1)
  12.         For Each A In .Range(.[E2], .[E2].End(xlDown))
  13.             '**************************
  14.             'F10 ,F11 ¦³´«¦æ¦r¤¸ »Ý­×§ï
  15.             '¤j ¨¦µ¾¥­
  16.             'Shohei Ohtan
  17.             '***************************
  18.             S = Replace(Trim(A), vbLf, Space(1)) '´«¦æ¦r¤¸ §ï¦¨ Space(1)
  19.             Set D(S) = Range(A.Offset(, 1).Address)
  20.             'Debug.Print S, D(S).Address  '«ü¥O:À˵ø->¤Î®Éµøµ¡¥i¬Ý¬Ý
  21.         Next
  22.     End With
  23.     ComboBox1.List = D.KEYS
  24.     Label1.WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  25.     With Image1               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  26.         .Picture = LoadPicture(xTempPicture)
  27.         .PictureAlignment = fmPictureAlignmentCenter '2
  28.         .PictureSizeMode = fmPictureSizeModeClip     '0
  29.     End With
  30.     With Image2               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  31.         .Picture = LoadPicture(xTempPicture)
  32.         .PictureAlignment = fmPictureAlignmentCenter '2
  33.         .PictureSizeMode = fmPictureSizeModeClip     '0
  34.     End With
  35. End Sub
  36. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  37.     Application.DisplayAlerts = False
  38.     Sh(2).Delete
  39.     Kill xTempPicture
  40.     Application.DisplayAlerts = True
  41. End Sub
  42. Private Sub ComboBox1_Change()
  43.     Dim A As Range
  44.     Label1.Caption = "¨S¦³¦¹¹Ï¤ù"
  45.     Image1.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  46.     Image2.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  47.     'Image1.Visible = False      '©Î¬OÁôÂÃ
  48.     With ComboBox1
  49.         If .ListIndex = -1 Then Exit Sub
  50.         ¹Ï¤ùÀˬd D(.List(.ListIndex)).Address, Image1
  51.         If ¹Ï¤ùÀˬd(D(.Value).Address, Image1) Then Label1.Caption = ComboBox1
  52.         If .ListIndex < .ListCount - 1 Then ¹Ï¤ùÀˬd D(.List(.ListIndex + 1)).Address, Image2
  53.     End With
  54. End Sub
  55. Private Function ¹Ï¤ùÀˬd(xPicture As String, xImage As Image) As Boolean
  56.     Dim S As Shape, P As Object, xName As String
  57.     For Each S In Sh(1).Shapes
  58.         '*************************************************
  59.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  60.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  61.             ¹Ï¤ùÀˬd = True
  62.             Set P = S '.Copy '¹Ï¤ù½Æ»s
  63.             Exit For
  64.         End If
  65.         '***************************************************
  66.     Next
  67.     If ¹Ï¤ùÀˬd = True Then
  68.         xName = "D:\temp.jpg"
  69.         ·Ó¤ùExport P, xName
  70.         xImage.Picture = LoadPicture(xName) 'ªí³æÅã¥Ü¹Ï¤ù
  71.         Kill xName ' "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
  72.     End If
  73.     End Function
  74. Private Sub ·Ó¤ùExport(P As Object, xName As String)
  75.     P.Copy
  76.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  77.         .Chart.Paste '¶K¤W¹Ï¤ù
  78.         .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  79.         .Delete '§R°£¹Ïªí
  80.      End With
  81. End Sub
  82. Sub ¶×¤J¹Ï¤ù()
  83.     Dim P As Picture
  84.     With Sh(2)
  85.         Set P = .Pictures.Insert("http://forum.twbts.com/templates/discuz6/images/logotop.png") '(¤u§@ªí¤W´¡¤J·Ó¤ù)
  86.         With [a1]                           '«ü©wªºÀx¦s®æ
  87.             P.Top = .Top                    '·Ó¤ùªº¥k¤è¦b¤u§@ªí¤Wªº¦ì¸m
  88.             P.Left = .Left                  '·Ó¤ùªº¥k¤è¦b¤u§@ªí¤Wªº¦ì¸m
  89.             .RowHeight = IIf(P.Height >= 409, 409, P.Height)        '½Õ¾ãÀx¦s®æ°ª«×=>·Ó¤ùªº°ª«×
  90.             P.Height = IIf(P.Height >= 409, 409, P.Height)          '½Õ¾ãÀx¦s®æ°ª«×=>·Ó¤ùªº°ª«×
  91.             If .Width < P.Width * (.ColumnWidth / .Width) Then   '¤U¸ü·Ó¤ùªº³Ì¤j¼e«×
  92.              .Width = P.Width * (.ColumnWidth / .Width)
  93.             .ColumnWidth = P.Width * (.ColumnWidth / .Width)    '½Õ¾ãÀx¦s®æÄæ¼e=>·Ó¤ùªº¼e«×
  94.             End If
  95.        End With
  96.      End With
  97.     ·Ó¤ùExport P, xTempPicture
  98. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ jeffrey628litw ©ó 2018-6-15 13:45 ½s¿è

¦^´_ 5# GBKEE


    ¶W¯Åª©¥D±z¦n¡G
§Úµo²{¦³3­Ó°ÝÃD¡A­n³Â·Ð±z¡A°ÝÃD¦p¤U¡G
1.    °ÝÃD1.
¹w³]¹Ï®×¼´ F1Àx¦s®æ¹Ï®× (©ÎªÌ±z³o¸Ì¥i¥H¼g¦¨¹w³]¹Ï¤ù¬ONull)
°ÝÃD1.¹w³]¹Ï®×¼´ F1Àx¦s®æ¹Ï®×.jpg
2018-6-15 13:30


2.    °ÝÃD2.
¼´ªº¦W¦r¥¿½Tªº¹Ï®×·|¥X¨Ó¡A¦ý·|¦h¼´¤U1Äæ¹Ï¤ù¡A¨S¦³¸ê®ÆªºÀ³¸Ó¼´ªº¹Ï¬OF1Àx¦s®æªº¨S¦³¹Ï¤ù (¦pªG°ÝÃD1±z¼g¦¨¹w³]¹Ï¤ù¬ONull¨º´N¤£¥Î¼´F1Àx¦s®æ)
°ÝÃD2.¼´ªº¦W¦r¥¿½Tªº¹Ï®×·|¥X¨Ó¡A¦ý·|¦h¼´¤U1Äæ¹Ï¤ù¡AÀ³¸ÓÅã¥ÜF1¨S¦³¹Ï¤ù.jpg
2018-6-15 13:31


3.    °ÝÃD3.
¼´¦P¦W¦r®É¨Ò¦p¤j¨¦µ¾¥­¡A¼´¤£¥X¦P¼Ë¦W¦r¦ý¤£¦P¹Ï¤ù

²{ª¬¡G
°ÝÃD3.¼´¦P¦W¦r®É¨Ò¦p¤j¨¦µ¾¥­¦P®É¼´¤£¥X¦P¼Ë¦W¦r¦ý¤£¦P¹Ï¤ù.jpg
2018-6-15 13:31

§Æ±æ§ïµ½¦¨Combobox1 (§Y¤U©Ô Players Name)¼´¦P¦W¦r®É¯à¼´¥X¤£¦P¹Ï¡A¦p¤U¹Ï¡G
°ÝÃD3§Æ±æ§ïµ½¦¨³o¼Ë.jpg
2018-6-15 13:31



¸É¥R¹Ï¤ùµ¹±z©ñ¤JF1Àx¦s®æ©ÎªÌ¼gµ{¦¡¸ô®|§ì¹Ï¥Î¡G
¨S¦³¹Ï¤ù.jpg
2018-6-15 13:44


Àɮצb¶³ºÝ¡Ghttp://webhd.xuite.net/_oops/jeffrey628litw/l0e

TOP

¦^´_ 6# jeffrey628litw
¦A¸Õ¸Õ
  1. Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
  2. Dim Sh(1 To 2) As Worksheet, xTempPicture As String '¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
  3. Private Sub UserForm_Initialize()
  4.     Dim A As Range, i As Integer
  5.     Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  6.     Set Sh(2) = ThisWorkbook.Sheets.Add
  7.     ¶×¤J¹Ï¤ù   '¸m¤J"¨S¦³¹Ï¤ù"ÀÉ
  8.      '¤£­n¥Î¦r¨åª«¥ó    Set D = CreateObject("Scripting.Dictionary")
  9.     With ComboBox1
  10.         For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
  11.            'ColumnCount ÄÝ©Ê ­Y±N ColumnCount ³]¦¨ 0¡AÅã¥Üªº¦æ¼Æ«K¬O 0¡F­Y³]¦¨ -1¡A«KÅã¥Ü©Ò¦³ªº¸ê®Æ¦æ¡C¹ï¤@­Ó«D¸ê®Æ³sµ²ªº¸ê®Æ¨Ó·½¦Ó¨¥¡A³Ì¦h¥u¯à¦³ 10 ¦æ (0 ¨ì 9)¡C
  12.             .ColumnCount = 2  '¤F¸Ñ«á,¥i¤£¥Î¦¹¦æµ{¦¡½X?
  13.             .AddItem
  14.             .List(.ListCount - 1, 0) = A
  15.             .List(.ListCount - 1, 1) = A.Offset(, 1).Address
  16.         Next
  17.     End With
  18.     Label1.WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  19.     Label4.WordWrap = False   '*******·s¼WLabel±±¨î¶µ
  20.    
  21.     With Image1               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  22.         .Picture = LoadPicture(xTempPicture)
  23.         .PictureAlignment = fmPictureAlignmentCenter '2
  24.         .PictureSizeMode = fmPictureSizeModeClip     '0
  25.     End With
  26.     With Image2               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  27.         .Picture = LoadPicture(xTempPicture)
  28.         .PictureAlignment = fmPictureAlignmentCenter '2
  29.         .PictureSizeMode = fmPictureSizeModeClip     '0
  30.     End With
  31. End Sub
  32. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  33.     Application.DisplayAlerts = False
  34.     Sh(2).Delete
  35.     Kill xTempPicture
  36.     Application.DisplayAlerts = True
  37. End Sub
  38. Private Sub ComboBox1_Change()
  39.     Dim A As Range
  40.     Label1.Caption = "¨S¦³¦¹¹Ï¤ù"
  41.     Label4.Caption = "¨S¦³¦¹¹Ï¤ù"  '*******·s¼WLabel±±¨î¶µ
  42.     Image1.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  43.     Image2.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  44.     With ComboBox1
  45.         If .ListIndex = -1 Then Exit Sub
  46.         If ¹Ï¤ùÀˬd(.List(.ListIndex, 1), Image1) = True Then Label1.Caption = .Value
  47.         If .ListIndex < .ListCount - 1 Then
  48.             If ¹Ï¤ùÀˬd(.List(.ListIndex + 1, 1), Image2) Then Label4.Caption = .List(.ListIndex + 1, 0)
  49.                                                                '*******·s¼WLabel±±¨î¶µ
  50.         End If
  51.     End With
  52. End Sub
  53. Private Function ¹Ï¤ùÀˬd(xPicture As String, xImage As Image) As Boolean
  54.     Dim S As Shape, P As Object, xName As String
  55.     For Each S In Sh(1).Shapes
  56.         '*************************************************
  57.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  58.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  59.             ¹Ï¤ùÀˬd = True
  60.             Set P = S '.Copy '¹Ï¤ù½Æ»s
  61.             Exit For
  62.         End If
  63.         '***************************************************
  64.     Next
  65.     If ¹Ï¤ùÀˬd = True Then
  66.         xName = "D:\temp.jpg"
  67.         ·Ó¤ùExport P, xName
  68.         xImage.Picture = LoadPicture(xName) 'ªí³æÅã¥Ü¹Ï¤ù
  69.         Kill xName ' "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
  70.     End If
  71.     End Function
  72. Private Sub ·Ó¤ùExport(P As Object, xName As String)
  73.     P.Copy
  74.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  75.         .Chart.Paste '¶K¤W¹Ï¤ù
  76.         .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  77.         .Delete '§R°£¹Ïªí
  78.      End With
  79. End Sub
  80. Sub ¶×¤J¹Ï¤ù()
  81.     Dim P As Range
  82.     xTempPicture = "D:\NoPicture.jpg"
  83.     Set P = Sh(1).[f2]
  84.     P.CopyPicture
  85.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  86.         .Chart.Paste '¶K¤W¹Ï¤ù
  87.         .Chart.Export xTempPicture '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  88.         .Delete '§R°£¹Ïªí
  89.      End With
  90. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 7# GBKEE


    G¤j ¶W¯Åª©¥D±z¦n¡A§Ú¬Ý±z¤w¸g¦³±N§Ú°ÝÃD1¸Ñ¨M¤F¡A¥t¥~­nµ{¦¡¤¤»¡©ú­n·s¼W Lable4 §Ú¤]·s¼W¤F¡A

    °ÝÃD2©M3ÁÙ¨S¸Ñ¨M¡A

   ±µ¤U¨Ó¡A
µ{¦¡ªºÅÞ¿è¬O­n¨Ì¾Ú¼´¥XªºLable4 ¦pªGµ²ªG¦PLable1ªº¦r¦ê¡A«h¼´¥X¹Ï¤ù¡A§_«h¼´¥XNullªº¹Ï¤ù¶Ü?

   ¬O³o¼Ëªº¸Ü½Ð°Ý­n¦p¦ó¼g©O? ¦]¬°§Ú¹ï©óVBA¹ê¦b´X¥G§¹¥þ¤£¤F¸Ñ¡A¯à§_½Ð±zÀ°¦£¤@ÂI¤@ÂI¸Ñµ¹§Ú¬Ý¡A§ÚºCºC¾Ç©O?
ÁÂÁ±z¡C

Àɮצb¶³ºÝ¡Ghttp://webhd.xuite.net/_oops/jeffrey628litw/wyh

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-6-16 06:26 ½s¿è

¦^´_ 8# jeffrey628litw
¹ï©óVBA¤£¤F¸Ñ,¥i¦h¬Ý¬Ý½×¾Âªº¥DÃD¤ÎVBA¤W»¡©ú,¨Ã¦h½m²ß,·|¶i¨Bªº
¤£À´¥i´£°Ý.¤º®eÅý¤H¬ÝÀ´´N·|±o¨ì¦^ÂÐ(¸q°È©Ê)

¦p¦³¤£²Å,½Ð¦A¸Ô¥[»¡©ú
  1. Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
  2. Dim Sh(1 To 2) As Worksheet, D As Object, xTempPicture As String  '¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
  3. Private Sub UserForm_Initialize()
  4.     Dim A As Range, S As String
  5.     Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  6.     Set Sh(2) = ThisWorkbook.Sheets.Add
  7.      xTempPicture = "D:\NoPicture.jpg"
  8.     ·Ó¤ùExport Sh(1).Range("F2"), xTempPicture '¸m¤J"¨S¦³¹Ï¤ù"ÀÉ
  9.     Set D = CreateObject("Scripting.Dictionary")
  10.     For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
  11.          S = Replace(Trim(A), vbLf, Space(1)) '´«¦æ¦r¤¸ §ï¦¨ Space(1)
  12.             If D.EXISTS(S) Then
  13.                 D(S) = D(S) & "," & A.Offset(, 1).Address
  14.             Else
  15.                 D(S) = A.Offset(, 1).Address
  16.             End If
  17.     Next
  18.     ComboBox1.List = D.KEYS
  19.     Label1.WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  20.     Label4.WordWrap = False   '*******·s¼WLabel±±¨î¶µ
  21.     With Image1               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  22.         .Picture = LoadPicture(xTempPicture)
  23.         .PictureAlignment = fmPictureAlignmentCenter '2
  24.         .PictureSizeMode = fmPictureSizeModeClip     '0
  25.     End With
  26.     With Image2               '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  27.         .Picture = LoadPicture(xTempPicture)
  28.         .PictureAlignment = fmPictureAlignmentCenter '2
  29.         .PictureSizeMode = fmPictureSizeModeClip     '0
  30.     End With
  31. End Sub
  32. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  33.     Application.DisplayAlerts = False
  34.     Sh(2).Delete
  35.     Kill xTempPicture
  36.     Application.DisplayAlerts = True
  37. End Sub
  38. Private Sub ComboBox1_Change()
  39.     Dim A As Variant, i As Integer, S As String
  40.     Label1.Caption = "¨S¦³¦¹¹Ï¤ù"
  41.     Label4.Caption = "¨S¦³¦¹¹Ï¤ù"  '*******·s¼WLabel±±¨î¶µ
  42.     Image1.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  43.     Image2.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  44.     With ComboBox1
  45.         If .ListIndex = -1 Then Exit Sub
  46.         A = Split(D(.Value), ",")
  47.         For i = 0 To 1
  48.             If i <= UBound(A) Then
  49.                 S = A(i)
  50.                 If ¹Ï¤ùÀˬd(S, IIf(i = 0, Image1, Image2)) Then Label1.Caption = .Value
  51.             End If
  52.         Next
  53.         Label4.Visible = UBound(A) = 0   '¦³¬Û¦Pªº Player Name «h¤£Åã¥Ü
  54.         If UBound(A) = 0 And .ListIndex < .ListCount - 1 Then
  55.             A = Split(D(.List(.ListIndex + 1)), ",")
  56.             S = A(0)
  57.             If ¹Ï¤ùÀˬd(S, Image2) Then Label4.Caption = .List(.ListIndex + 1, 0)
  58.                                                                '*******·s¼WLabel±±¨î¶µ
  59.         End If
  60.     End With
  61. End Sub
  62. Private Function ¹Ï¤ùÀˬd(xPicture As String, xImage As Image) As Boolean
  63.     Dim S As Shape, xName As String
  64.     For Each S In Sh(1).Shapes
  65.         '*************************************************
  66.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  67.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  68.             ¹Ï¤ùÀˬd = True
  69.             Exit For
  70.         End If
  71.         '***************************************************
  72.     Next
  73.     If ¹Ï¤ùÀˬd = True Then
  74.         xName = "D:\temp.jpg"
  75.         ·Ó¤ùExport S, xName
  76.         xImage.Picture = LoadPicture(xName) 'ªí³æÅã¥Ü¹Ï¤ù
  77.         Kill xName ' "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
  78.     End If
  79.     End Function
  80. Private Sub ·Ó¤ùExport(P As Object, xName As String)
  81.     If xName <> "D:\temp.jpg" Then
  82.         P.CopyPicture
  83.     Else
  84.         P.Copy
  85.     End If
  86.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  87.         .Chart.Paste '¶K¤W¹Ï¤ù
  88.         .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  89.         .Delete '§R°£¹Ïªí
  90.      End With
  91. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 9# GBKEE


    G¤j ª©¥D±z¦n¡G§Ú¬Ý¤F°ÝÃD3¤]¸Ñ¨M¤F¡A³Ñ¤U°ÝÃD2¡A³oÅÞ¿è¬O­n¼g

·íLable1 And Lable4 ¤£¬°ªÅ®É¥B¤£¬Û¦P¡A«hÅã¥Ü2±i¹Ï¤ù¨ìImage1 ©MImage4¡A
§_«h ·íLable1¤£µ¥©ó Label4¡A«hÅã¥ÜImage1 ¥B Image4¬°ªÅ
§_«h ·íLabel1µ¥©óªÅ¡ALable4¤£µ¥©óªÅ¡A«hÅã¥ÜImage1¬°ªÅ ¥BÅã¥Ü Image4ªº¹Ï¤ù

¬O³o¼Ë¤l¶Ü? ¬Oªº¸Üµ{¦¡­n«ç»ò¼g©O?¦A½Ð±z½ç±Ð¡AÁÂÁ¡C

¶³ºÝÀɮסGhttp://webhd.xuite.net/_oops/jeffrey628litw/gdn

TOP

        ÀR«ä¦Û¦b : ¦³¤ß´N¦³ºÖ¡A¦³Ä@´N¦³¤O¡A¦Û³yºÖ¥Ð¡A¦Û±oºÖ½t¡C
ªð¦^¦Cªí ¤W¤@¥DÃD