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

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

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-6-20 09:01 ½s¿è

¦^´_ 14# jeffrey628litw
¸Õ¸Õ¬Ý
  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. Dim AR_Image(), AR_TexTbox(), AR_Label(), xName As String
  4. Private Sub UserForm_Initialize()
  5.     Dim A As Range, S As String, E As Variant
  6.     Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  7.     Set Sh(2) = ThisWorkbook.Sheets.Add
  8.     AR_Image = Array(Image1, Image2, Image3, Image4)
  9.     AR_TexTbox = Array(TextBox1, TextBox2, TextBox3, TextBox4)
  10.     AR_Label = Array(Label1, Label4, Label6, Label8)
  11.     xTempPicture = "D:\NoPicture.jpg"
  12.     xName = "D:\temp.jpg"
  13.     ·Ó¤ùExport Sh(1).Range("F2"), xTempPicture '¸m¤J"¨S¦³¹Ï¤ù"ÀÉ ·í§@¹w³]¹Ï¤ù¤Î¨S¦³¹Ï¤ù
  14.     Set D = CreateObject("Scripting.Dictionary")
  15.     For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
  16.          S = Replace(Trim(A), vbLf, Space(1)) '´«¦æ¦r¤¸ §ï¦¨ Space(1)
  17.             If D.EXISTS(S) Then
  18.                 D(S) = D(S) & "," & A.Offset(, 1).Address
  19.             Else
  20.                 D(S) = A.Offset(, 1).Address
  21.             End If
  22.     Next
  23.     ComboBox1.List = D.KEYS
  24.     For E = 0 To UBound(AR_Image)
  25.         With AR_Image(E)            '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡
  26.             .Picture = LoadPicture(xTempPicture)
  27.             .PictureAlignment = fmPictureAlignmentCenter ' ***  0,1,2,3,4
  28.             .PictureSizeMode = 3 'fmPictureSizeModeClip  ' ***  0,1,3
  29.             '***** ½Ð¦Û¦æ½Õ¾ã******
  30.             '**1.Åã¥Ü¹Ï¤ù¥i¥H¦Û°Ê½Õ¾ã¹Ï¤ù¤j¤p¦b®Ø®Ø¤º¡G±NDisplay Each Player Photo ³o«ö¶sÅã¥Üªº¥Õ¦â®Ø®Ø¤º¹Ï¤ù¥i¥H
  31.             '***¦Û°ÊÅã¥Ü©M After Sieve Display Photo ¥Õ¦â®Ø®Ø¤º¹Ï¤ù¦Û°Ê½Õ¾ã¤j¤p¤Î¦ì¸m
  32.         End With
  33.         AR_TexTbox(E).MultiLine = True   '«ü©w±±¨î¶µ¬O§_±µ¨ü¨ÃÅã¥Ü¦h¦æ¤å¦r¡C
  34.         AR_Label(E).WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  35.     Next
  36. End Sub
  37. '***********************************************************************************
  38. '¥H¤U¬°¶}±ÒUserForm1®É·|¦Û°Ê¶}±Ò1¤u§@ªí¡A¦³¥H¤Uµ{¦¡¦bÃö³¬UserForm1®É·|¦Û°ÊÃö³¬¤u§@ªí
  39. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  40.     Application.DisplayAlerts = False
  41.     Sh(2).Delete
  42.     Kill xTempPicture
  43.     Kill xName ' "D:\temp.jpg" '§R°£¼È¦s¹Ï¤ù
  44.     Application.DisplayAlerts = True
  45. End Sub
  46. '***********************************************************************************
  47. Private Sub ComboBox1_Change()
  48.     Dim A As Variant, i As Integer, S As String, ii As Integer
  49.     For i = 0 To UBound(AR_Label)
  50.         AR_Label(i).Caption = "¨S¦³¦¹¹Ï¤ù"
  51.         AR_TexTbox(i).Text = ""
  52.         AR_Image(i).Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù ¬° Databasse ¤u§@ªí¤¤ªº F3 Àx¦s®æ¹Ï¤ù
  53.     Next
  54.     With ComboBox1
  55.         If .ListIndex = -1 Then Exit Sub
  56.         A = Split(D(.Value), ",")
  57.         For i = 0 To 3                    '¦p­n¼W¥[©Î´î¤Ö¹Ï¤ù«h ­×§ï i = 0 To 3 «á­±ªº3ªº¼Æ¶q
  58.             If i <= UBound(A) Then
  59.                 S = A(i)
  60.                 If ¹Ï¤ùÀˬd(S) Then '
  61.                     AR_Image(ii).Picture = LoadPicture(xName)
  62.                     AR_Label(ii).Caption = Sh(1).Range(S).Offset(, -1).Text
  63.                     AR_TexTbox(ii).Text = Sh(1).Range(S).Offset(, -4).Text
  64.                     ii = ii + 1
  65.                 End If
  66.             End If
  67.         Next
  68.     End With
  69. End Sub
  70. Private Function ¹Ï¤ùÀˬd(xPicture As String) As Boolean
  71.     Dim S As Shape
  72.     For Each S In Sh(1).Shapes
  73.         '*************************************************
  74.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  75.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  76.             ¹Ï¤ùÀˬd = True
  77.             Exit For
  78.         End If
  79.         '***************************************************
  80.     Next
  81.     If ¹Ï¤ùÀˬd = True Then ·Ó¤ùExport S, xName
  82.    
  83. End Function

  84. Private Sub ·Ó¤ùExport(P As Object, xName As String)
  85.     If xName <> "D:\temp.jpg" Then
  86.         P.CopyPicture
  87.     Else
  88.         P.Copy
  89.     End If
  90.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  91.         .Chart.Paste '¶K¤W¹Ï¤ù
  92.         .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  93.         .Delete '§R°£¹Ïªí
  94.      End With
  95. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 13# jeffrey628litw


    ³o­Ó°ÝÃD¤U­±¼g¿ù¡AÀ³¸Ó¬O
2.·Q­nÅã¥Ü¹Ï¤ù¸ê®Æ¡A¥H«K¶W³sµ²¨ìDatabase ¤u§@ªí¡A(¤£ª¾¬O§_¥ÎTextbox¡A¬Oªº¸Ü­n¦p¦ó¼gVBA©O?)
1.§Æ±æ±N¤u§@ªíDatabase ¸Ì­±±NEÄæ¹ïÀ³BÄ檺¸ê®Æ¼´¥X¨Ó¡A
¨ìTextbox¡A
¨Ò¦pE3¼´¥XB3¨ìTextbox1
2.µM«áÅýTextboxªº¤å¦r¶W³sµ²¨ì¤u§@ªí Database

TOP

¥»©«³Ì«á¥Ñ jeffrey628litw ©ó 2018-6-18 09:46 ½s¿è

¦^´_ 11# GBKEE


    G¤j ª©¤j±z¦n¡G§Ú¦³¦Û¤v§ï¦¨¥i¥H¼´4­Ó¹Ï¤ùªºÀɮסA¦p¤µ¦³·sªº°ÝÃD¡G
1.Åã¥Ü¹Ï¤ù¥i¥H¦Û°Ê½Õ¾ã¹Ï¤ù¤j¤p¦b®Ø®Ø¤º¡G±NDisplay Each Player Photo ³o«ö¶sÅã¥Üªº¥Õ¦â®Ø®Ø¤º¹Ï¤ù¥i¥H
¦Û°ÊÅã¥Ü©M After Sieve Display Photo ¥Õ¦â®Ø®Ø¤º¹Ï¤ù¦Û°Ê½Õ¾ã¤j¤p¤Î¦ì¸m

    §ï¦¨-->   ¦P¤j¤p¤Î¦ì¸m

2.·Q­nÅã¥Ü¹Ï¤ù¸ê®Æ¡A¥H«K¶W³sµ²¨ìDatabase ¤u§@ªí¡A(¤£ª¾¬O§_¥ÎTextbox¡A¬Oªº¸Ü­n¦p¦ó¼gVBA©O?)
1.§Æ±æ±N¤u§@ªíDatabase ¸Ì­±±NEÄæ¹ïÀ³BÄ檺¸ê®Æ¼´¥X¨Ó¡A
¨ìTextbox¡A
¨Ò¦pE3¼´¥XB3¨ìTextbox1
2.µM«áÅýDatabaseªº¤å¦r¶W³sµ²¨ì¤u§@ªí Database


Àɮ׶³ºÝ³sµ²¡Ghttp://webhd.xuite.net/_oops/jeffrey628litw/u05

ÁÂÁª©¤jªºÀ°¦£¡C

TOP

¦^´_ 11# GBKEE


    G¤j ª©¥D±z¦n¡G¹ï©ó°ÝÃD2 §Ú¦³·Ó±z»¡ªº±N­þ¤@¬qµ{¦¡ÁôÂôN¤£·|±N¨S¦³ªº¸ê®Æ¹ïÀ³ªº¹Ï¤ù¡A¼´¥X¤U¤@±i¹Ï¤ù¤F¡C
¬O§Ú¤§«e¨S¦³¸ò±z»¡²M·¡¡C

   ³o¼Ë´N¥þ³¡¸Ñ¨M¤F§Úªº°ÝÃD¤F¡A«Ü·PÁ±z³o»ò¦³­@¤ß¦a¦^ÂЧڪº°ÝÃD¡A¦A¦¸·PÁ±z¡C

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2018-6-17 11:04 ½s¿è

¦^´_ 10# jeffrey628litw

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®æ)
³o¬O 6#¤¤ªº´£°Ý
§Ú²z¸Ñ¬OComboBox1©Ò¿ïªº¦W¦r¦³¹Ï®×®É Åãµø¦bImage1,¨S¦³¹Ï®×®ÉImage1¦¨¹w³]¹Ï¤ù(µ¹ªºµ{¦¡¬O³o¼Ë¼g¨S¿ù)

Ãö©óImage2 ³oµ{¦¡½X±ø¥ó¦¨¥ß®É¤~³B²z(³o¬O§Ú¦h°µªº³B²z¶Ü?)
  1. If UBound(A) = 0 And .ListIndex < .ListCount - 1 Then
½Æ»s¥N½X
UBound(A) = 0   **ComboBox1©Ò¿ïªº¦W¦r¦bDatabase¤¤¬O¤@ªº¦W¦r**
.ListIndex < .ListCount - 1   **©Ò¿ïªº¦W¦r¦bComboBox1ªºlist¤¤¤£¬O³Ì«á¤@­Óvalue(­È)¦W¦r
±N¤U­Ó¦W¦rªº¹Ï¤ùÅãµø¦bImage2

¦p¤£³B²z«h¶}ÀY´N³B²z¤F
  1. Private Sub ComboBox1_Change()
  2.     Dim A As Variant, i As Integer, S As String
  3.     Label1.Caption = "¨S¦³¦¹¹Ï¤ù"
  4.     Label4.Caption = "¨S¦³¦¹¹Ï¤ù"  '*******·s¼WLabel±±¨î¶µ
  5.     Image1.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
  6.     Image2.Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù
½Æ»s¥N½X
*****************************
3.    °ÝÃD3.
¼´¦P¦W¦r®É¨Ò¦p¤j¨¦µ¾¥­¡A¼´¤£¥X¦P¼Ë¦W¦r¦ý¤£¦P¹Ï¤ù,§Æ±æ§ïµ½¦¨Combobox1 (§Y¤U©Ô Players Name)¼´¦P¦W¦r®É¯à¼´¥X¤£¦P¹Ï
UBound(A) > 0®É-> **ComboBox1©Ò¿ïªº¦W¦r¦bDatabase¤£¬O¤@ªº¦W¦r**
  1. A = Split(D(.Value), ",")
  2.         For i = 0 To 1
  3.             If i <= UBound(A) Then
  4.                 S = A(i)
  5.                 If ¹Ï¤ùÀˬd(S, IIf(i = 0, Image1, Image2)) Then Label1.Caption = .Value
  6.             End If
  7.         Next
½Æ»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

¥»©«³Ì«á¥Ñ 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

¦^´_ 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

¦^´_ 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

¥»©«³Ì«á¥Ñ 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)


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®æ)


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

²{ª¬¡G

§Æ±æ§ïµ½¦¨Combobox1 (§Y¤U©Ô Players Name)¼´¦P¦W¦r®É¯à¼´¥X¤£¦P¹Ï¡A¦p¤U¹Ï¡G



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

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

TOP

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