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

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

¦^´_ 20# jeffrey628litw

F15Àx¦s®æ¬O¬G·N¤£©ñ¹Ï¤ù­n´ú¸Õ¼´¤£¼´ªº¥X¹w³]ªº¹Ï¤ù(¨S¦³¹Ï¤ù)
¨º¹Ï¤ù´N¨ÌÄò©ñ¦bImage1, Image2,Image3,Image4 ¤¤ Image3 ¬O¨S¦³¹Ï¤ùªº

­×§ï«á¬O±N¤T­Ó¦³¹Ï¤ù³sÄò©ñ¦bImage1, Image2,Image3 ,Image4 ¬O¨S¦³¹Ï¤ùªº
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 21# GBKEE


    G¤j  ª©¥D±z¦n¡G
    1.´N¨Ì·Ó±z»¡ªº¤è¦¡¡A¥i¥HÀ°§Ú¨º¼Ë§ï¶Ü?

     µM«á§Ú¤S¦³2­Ó°ÝÃD»Ý­n±zÀ°¦£§Ú¡G

    2.
       2-1.¥i¥H·s¼W1­ÓCombobox2 ¡AµM«á¿z¿ï¤u§@ªí Datababse   "JÄæ"¤£­«½Æ¸ê®Æ¡A¨Ò¦p BGS¡BPSA¡B¨SŲ©w¡C
       2-2.µM«á³o­ÓCombobox2¥i¥H¦pªGCombox1 ¿z¿ï¦W¦r«á¡A¦pMichael Jordan,µM«á¦A¿z¿ïCombobox2¿ïBGS«á¥X²{¹Ï¤ù

    3.µM«á¦]¬°¿z¿ï«á·|¶W¹L4±iImage¡A©Ò¥H­n»s§@¤À­¶¿z¿ï¡A³o¥i¥H¥ÎCombobox3»s§@¶Ü?¦p¹Ï¤¤¥k¤W¤è©Ò¥Ü

¹Ï¤ù 67jpg.jpg
2018-6-20 23:54


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

    ·PÁÂG¤j ª©¥D¡C

TOP

¦^´_ 22# jeffrey628litw
3.µM«á¦]¬°¿z¿ï«á·|¶W¹L4±iImage
ComboBox1 ¥kÃä·s¼W¤@ComboBox3
ComboBox2 ¥kÃä·s¼W¤@ComboBox4
  1. Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
  2. '¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
  3. Dim Sh(1 To 2) As Worksheet, D As Object, D1 As Object, xTempPicture As String
  4. Dim AR_Image(), AR_TexTbox(), AR_Label(), xName As String
  5. Private Sub UserForm_Initialize()
  6.     Dim A As Range, S As String, E As Variant
  7.     Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
  8.     Set Sh(2) = ThisWorkbook.Sheets.Add
  9.     AR_Image = Array(Image1, Image2, Image3, Image4)
  10.     AR_TexTbox = Array(TextBox1, TextBox2, TextBox3, TextBox4)
  11.     AR_Label = Array(Label1, Label4, Label6, Label8)
  12.     xTempPicture = "D:\NoPicture.jpg"
  13.     xName = "D:\temp.jpg"
  14.     ·Ó¤ùExport Sh(1).Range("F2"), xTempPicture '¸m¤J"¨S¦³¹Ï¤ù"ÀÉ ·í§@¹w³]¹Ï¤ù¤Î¨S¦³¹Ï¤ù
  15.     ComboBox³]©w ComboBox1, D
  16.     For E = 0 To UBound(AR_Image)
  17.         With AR_Image(E)            '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡ '***** ½Ð¦Û¦æ½Õ¾ã******
  18.             .Picture = LoadPicture(xTempPicture)
  19.             .PictureAlignment = fmPictureAlignmentCenter ' ***  0,1,2,3,4
  20.             .PictureSizeMode = 3 'fmPictureSizeModeClip  ' ***  0,1,3
  21.         End With
  22.         AR_TexTbox(E).MultiLine = True   '«ü©w±±¨î¶µ¬O§_±µ¨ü¨ÃÅã¥Ü¦h¦æ¤å¦r¡C
  23.         AR_Label(E).WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
  24.     Next
  25. End Sub
  26. '***********************************************************************************
  27. '¥H¤U¬°¶}±ÒUserForm1®É·|¦Û°Ê¶}±Ò1¤u§@ªí¡A¥H¤Uµ{¦¡¦bÃö³¬UserForm1®É·|¦Û°ÊÃö³¬¤u§@ªí
  28. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  29.     Application.DisplayAlerts = False
  30.     Sh(2).Delete
  31.     Kill xTempPicture
  32.     Kill xName ' "D:\temp.jpg"
  33.     Application.DisplayAlerts = True
  34. End Sub
  35. '***********************************************************************************
  36. Private Sub ComboBox1_Change()
  37.     Dim A As Variant, i As Integer, S As String, ii As Integer
  38.     ²M¹Ï
  39.     With ComboBox1
  40.         If .ListIndex = -1 Then ComboBox2.Clear: ComboBox3.Clear: ComboBox4.Clear: Exit Sub
  41.         If IsArray(D(.Value)) Then A = D(.Value)(0) Else A = D(.Value)
  42.         ComboBox­¶³]©w ComboBox3, A
  43.         ComboBox³]©w ComboBox2, D1
  44.         If ComboBox3.Enabled Then ComboBox3.ListIndex = 0
  45.     End With
  46. End Sub
  47. Private Sub ComboBox2_Change()
  48.     Dim A As Variant
  49.     With ComboBox2
  50.         ²M¹Ï
  51.         If .ListIndex = -1 Then Exit Sub
  52.         A = D1(.Value)
  53.         If IsArray(D1(.Value)) Then A = D1(.Value)(0) Else A = D1(.Value)
  54.         ComboBox­¶³]©w ComboBox4, A
  55.         If ComboBox4.Enabled Then ComboBox4.ListIndex = 0
  56.     End With
  57. End Sub
  58. Private Sub ComboBox3_Change()
  59.     ²M¹Ï
  60.     ComboBox4.Clear
  61.     If ComboBox3.ListIndex > -1 Then ³]¹Ï ComboBox1, ComboBox3, D
  62. End Sub
  63. Private Sub ComboBox4_Change()
  64.     ²M¹Ï
  65.     If ComboBox4.ListIndex > -1 Then ³]¹Ï ComboBox2, ComboBox4, D1
  66.         
  67. End Sub
  68. Private Sub ²M¹Ï()
  69.     Dim i As Integer
  70.     For i = 0 To UBound(AR_Label)
  71.         AR_Label(i).Caption = "¨S¦³¦¹¹Ï¤ù"
  72.         AR_TexTbox(i).Text = ""
  73.         AR_Image(i).Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù ¬° Databasse ¤u§@ªí¤¤ªº F3 Àx¦s®æ¹Ï¤ù
  74.     Next
  75. End Sub
  76. Private Sub ³]¹Ï(ComBo As MSForms.ComBobox, ComBobox As MSForms.ComBobox, D As Object)
  77.     Dim P As Object, i As Integer, ii As Integer
  78.     With ComBobox
  79.         For i = .ListIndex * 4 To (.ListIndex + 1) * 4 - 1
  80.             If i <= UBound(D(ComBo.Value)(0)) Then
  81.                 AR_Label(ii).Caption = D(ComBo.Value)(1)(i)
  82.                 AR_TexTbox(ii).Text = D(ComBo.Value)(2)(i)
  83.                 Set P = D(ComBo.Value)(0)(i)
  84.                 ·Ó¤ùExport P, xName
  85.                 AR_Image(ii).Picture = LoadPicture(xName) 'ªí³æÅã¥Ü¹Ï¤ù
  86.                 ii = ii + 1
  87.             End If
  88.         Next
  89.     End With
  90. End Sub
  91. Private Sub ComboBox­¶³]©w(ComBo As MSForms.ComBobox, S As Variant)
  92.     Dim i As Integer
  93.     With ComBo
  94.         .Clear
  95.         Debug.Print .Name
  96.         ComBo.Enabled = IsArray(S)
  97.         If Not IsArray(S) Then Exit Sub
  98.         For i = 0 To UBound(S) Step 4
  99.             .AddItem Int((i + 1) / 4) + IIf(4 Mod (i + 1) >= 0, 1, 0)
  100.         Next
  101.     End With
  102. End Sub
  103. Private Sub ComboBox³]©w(ComBo As MSForms.ComBobox, D As Variant)
  104.     Dim A As Range, S As String, E As Variant, i As Integer, ii As Integer, iii As Integer, AR, AR1()
  105.     Dim xShape As Shape
  106.     Set D = CreateObject("Scripting.Dictionary")
  107.     For Each A In Sh(1).Range(Sh(1).Range("E3"), Sh(1).Range("E3").End(xlDown))
  108.         If ComBo.Name = "ComboBox1" Then
  109.             S = Replace(Trim(A), vbLf, Space(1))
  110.         Else
  111.             If ComboBox1 <> Replace(Trim(A), vbLf, Space(1)) Or Trim(A.Offset(, 5)) = "" Then GoTo Net
  112.             S = Replace(Trim(A.Offset(, 5)), vbLf, Space(1)) '´«¦æ¦r¤¸ §ï¦¨ Space(1)
  113.         End If
  114.         Set xShape = ¹Ï¤ùÀˬd(A.Offset(, 1).Address)
  115.         If Not xShape Is Nothing Then
  116.             If D.EXISTS(S) Then
  117.                 If IsArray(D(S)) Then
  118.                     AR = D(S)
  119.                     iii = UBound(AR(0)) + 1
  120.                     For ii = 0 To UBound(AR)
  121.                         ReDim AR1(0 To iii)
  122.                         For i = 0 To UBound(AR1)
  123.                             If ii = 0 Then If i < UBound(AR1) Then Set AR1(i) = AR(ii)(i) Else Set AR1(i) = xShape
  124.                             If ii = 1 Then If i < UBound(AR1) Then AR1(i) = AR(ii)(i) Else AR1(i) = A.Text
  125.                             If ii = 2 Then If i < UBound(AR1) Then AR1(i) = AR(ii)(i) Else AR1(i) = Sh(1).Cells(A.Row, "B").Text
  126.                         Next
  127.                         AR(ii) = AR1
  128.                     Next
  129.                     D(S) = AR
  130.                 Else
  131.                     D(S) = Array(Array(xShape), Array(A.Text), Array(Sh(1).Cells(A.Row, "B").Text))
  132.                 End If
  133.             Else
  134.                 D(S) = Array(Array(xShape), Array(A.Text), Array(Sh(1).Cells(A.Row, "B").Text))
  135.             End If
  136.         Else
  137.             If Not D.EXISTS(S) Then D(S) = False
  138.         End If
  139. Net:
  140.     Next
  141.     ComBo.Clear
  142.     If D.Count > 0 Then ComBo.List = D.KEYS
  143. End Sub
  144. Private Function ¹Ï¤ùÀˬd(xPicture As String) As Object
  145.     Dim S As Shape
  146.      Set ¹Ï¤ùÀˬd = Nothing
  147.     For Each S In Sh(1).Shapes
  148.         '*************************************************
  149.         'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
  150.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  151.             Set ¹Ï¤ùÀˬd = S
  152.             Exit For
  153.         End If
  154.         '***************************************************
  155.     Next
  156. End Function
  157. Private Sub ·Ó¤ùExport(P As Object, xName As String)
  158.     If xName <> "D:\temp.jpg" Then
  159.         P.CopyPicture
  160.     Else
  161.         P.Copy
  162.     End If
  163.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
  164.         .Chart.Paste '¶K¤W¹Ï¤ù
  165.         .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
  166.         .Delete '§R°£¹Ïªí
  167.      End With
  168. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 23# GBKEE


    G¤j ª©¤j±z¦n¡G§Ú¦³¸Õ¥Î¹L·s¥\¯à¤F¡A³£¥i¥H¨Ï¥Î¸Ñ¨M¤F§Úªº°ÝÃD¡A¯uªº«Ü·PÁ±zªº¤j¤OÀ°¦£¡A§Ú¦A¬ã¨s±zªºµ{¦¡¡A
¤£¹L¦pªG¦³·sªº·Qªk»Ý¨D¡A¥i¯àÁÙ­n³Â·Ð±z¤F¡A¦A¦¸·PÁ¡A§Ú»°§Ö¦A¨Ó¬ã¨s¬Ý¬Ý¡C.....^^......

TOP

        ÀR«ä¦Û¦b : ·R¤£¬O­n¨D¹ï¤è¡A¦Ó¬O­n¥Ñ¦Û¨­ªº¥I¥X¡C
ªð¦^¦Cªí ¤W¤@¥DÃD