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

¦³¤j¤j¦³Excel 2010©Î2016¦~ª© ¥i¥HÀ°¦£´ú¸Õ­×§ï³oVBA ªí³æªºµ{¦¡½X¶Ü?

¦³¤j¤j¦³Excel 2010©Î2016¦~ª© ¥i¥HÀ°¦£´ú¸Õ­×§ï³oVBA ªí³æªºµ{¦¡½X¶Ü?

¥»©«³Ì«á¥Ñ jeffrey628litw ©ó 2019-5-22 13:54 ½s¿è

¥i¥H½Ð°Ý坂¤j GBKEE ¶Ü?  ³o¬O«Ü¤[¥H«e±zÀ°¦£¼gªºVBA ¡A¦ý2010¤Î2016 Excel ª©VBA ªí³æ³£¶]¤£¥X¨Ó¤F¡C
¥i¥H½Ð±zÀ°¦£´ú¸Õ§ïµ{¦¡½X¶Ü?



ÀɮפU¸ü¡Ghttp://www.FunP.Net/604675



¤u§@ªí¡GMain Query System ¸Ì­±ªºVBA ªí³æ

UserForm1 µ{¦¡½X¦p¤U¡G

Option Explicit                  '±j¨î ¼Ò²ÕªºÅܼƥ²¶·­n Dimªº«Å§i,·|¨Ïµ{¦¡©ö©ó°»¿ù
'¼Ò²Õ³»ºÝ¤W DimªºÅÜ¼Æ ¥i¦bUserForm1ªº¥þ³¡µ{¦¡¤¤¨Ï¥Î
Dim Sh(1 To 2) As Worksheet, D As Object, D1 As Object, xTempPicture As String
Dim AR_Image(), AR_TexTbox(), AR_Label(), xName As String
Private Sub UserForm_Initialize()
    Dim A As Range, S As String, E As Variant
    Set Sh(1) = ThisWorkbook.Sheets("Database") '¤u§@ªí¦p¦³Åܰʮɦb¦¹­×§ï§Y¥i
    Set Sh(2) = ThisWorkbook.Sheets.Add
    AR_Image = Array(Image1, Image2, Image3, Image4)
    AR_TexTbox = Array(TextBox1, TextBox2, TextBox3, TextBox4)
    AR_Label = Array(Label1, Label4, Label6, Label8)
    xTempPicture = "D:\NoPicture.jpg"
    xName = "D:\temp.jpg"
    ·Ó¤ùExport Sh(1).Range("F2"), xTempPicture '¸m¤J"¨S¦³¹Ï¤ù"ÀÉ ·í§@¹w³]¹Ï¤ù¤Î¨S¦³¹Ï¤ù
    ComboBox³]©w ComboBox1, D
    For E = 0 To UBound(AR_Image)
        With AR_Image(E)            '³]©w¹Ï¤ùªºÅã¥Ü³]¼Ò¦¡ '***** ½Ð¦Û¦æ½Õ¾ã******
            .Picture = LoadPicture(xTempPicture)
            .PictureAlignment = fmPictureAlignmentCenter ' ***  0,1,2,3,4
            .PictureSizeMode = 3 'fmPictureSizeModeClip  ' ***  0,1,3
        End With
        AR_TexTbox(E).MultiLine = True   '«ü©w±±¨î¶µ¬O§_±µ¨ü¨ÃÅã¥Ü¦h¦æ¤å¦r¡C
        AR_Label(E).WordWrap = False   '¤º®e¦b¦æ¥½¬O§_¦Û°Ê´«¦æ
    Next
End Sub
'***********************************************************************************
'¥H¤U¬°¶}±ÒUserForm1®É·|¦Û°Ê¶}±Ò1¤u§@ªí¡A¥H¤Uµ{¦¡¦bÃö³¬UserForm1®É·|¦Û°ÊÃö³¬¤u§@ªí
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.DisplayAlerts = False
    Sh(2).Delete
    Kill xTempPicture
    Kill xName ' "D:\temp.jpg"
    Application.DisplayAlerts = True
End Sub
'***********************************************************************************
Private Sub ComboBox1_Change()
    Dim A As Variant, i As Integer, S As String, ii As Integer
    ²M¹Ï
    With ComboBox1
        If .ListIndex = -1 Then ComboBox2.Clear: ComboBox3.Clear: ComboBox4.Clear: Exit Sub
        If IsArray(D(.Value)) Then A = D(.Value)(0) Else A = D(.Value)
        ComboBox­¶³]©w ComboBox3, A
        ComboBox³]©w ComboBox2, D1
        If ComboBox3.Enabled Then ComboBox3.ListIndex = 0
    End With
End Sub
Private Sub ComboBox2_Change()
    Dim A As Variant
    With ComboBox2
        ²M¹Ï
        If .ListIndex = -1 Then Exit Sub
        A = D1(.Value)
        If IsArray(D1(.Value)) Then A = D1(.Value)(0) Else A = D1(.Value)
        ComboBox­¶³]©w ComboBox4, A
        If ComboBox4.Enabled Then ComboBox4.ListIndex = 0
    End With
End Sub
Private Sub ComboBox3_Change()
    ²M¹Ï
    ComboBox4.Clear
    If ComboBox3.ListIndex > -1 Then ³]¹Ï ComboBox1, ComboBox3, D
End Sub
Private Sub ComboBox4_Change()
    ²M¹Ï
    If ComboBox4.ListIndex > -1 Then ³]¹Ï ComboBox2, ComboBox4, D1
        
End Sub
Private Sub ²M¹Ï()
    Dim i As Integer
    For i = 0 To UBound(AR_Label)
        AR_Label(i).Caption = "¨S¦³¦¹¹Ï¤ù"
        AR_TexTbox(i).Text = ""
        AR_Image(i).Picture = LoadPicture(xTempPicture) 'ªí³æ¹w³]ªº¹Ï¤ù ¬° Databasse ¤u§@ªí¤¤ªº F3 Àx¦s®æ¹Ï¤ù
    Next
End Sub
Private Sub ³]¹Ï(ComBo As MSForms.ComBobox, ComBobox As MSForms.ComBobox, D As Object)
    Dim P As Object, i As Integer, ii As Integer
    With ComBobox
        For i = .ListIndex * 4 To (.ListIndex + 1) * 4 - 1
            If i <= UBound(D(ComBo.Value)(0)) Then
                AR_Label(ii).Caption = D(ComBo.Value)(1)(i)
                AR_TexTbox(ii).Text = D(ComBo.Value)(2)(i)
                Set P = D(ComBo.Value)(0)(i)
                ·Ó¤ùExport P, xName
                AR_Image(ii).Picture = LoadPicture(xName) 'ªí³æÅã¥Ü¹Ï¤ù
                ii = ii + 1
            End If
        Next
    End With
End Sub
Private Sub ComboBox­¶³]©w(ComBo As MSForms.ComBobox, S As Variant)
    Dim i As Integer
    With ComBo
        .Clear
        Debug.Print .Name
        ComBo.Enabled = IsArray(S)
        If Not IsArray(S) Then Exit Sub
        For i = 0 To UBound(S) Step 4
            .AddItem Int((i + 1) / 4) + IIf(4 Mod (i + 1) >= 0, 1, 0)
        Next
    End With
End Sub
Private Sub ComboBox³]©w(ComBo As MSForms.ComBobox, D As Variant)
    Dim A As Range, S As String, E As Variant, i As Integer, ii As Integer, iii As Integer, AR, AR1()
    Dim xShape As Shape
    Set D = CreateObject("Scripting.Dictionary")
    For Each A In Sh(1).Range(Sh(1).Range("E3"), Sh(1).Range("E3").End(xlDown))
        If ComBo.Name = "ComboBox1" Then
            S = Replace(Trim(A), vbLf, Space(1))
        Else
            If ComboBox1 <> Replace(Trim(A), vbLf, Space(1)) Or Trim(A.Offset(, 5)) = "" Then GoTo Net
            S = Replace(Trim(A.Offset(, 5)), vbLf, Space(1)) '´«¦æ¦r¤¸ §ï¦¨ Space(1)
        End If
        Set xShape = ¹Ï¤ùÀˬd(A.Offset(, 1).Address)
        If Not xShape Is Nothing Then
            If D.EXISTS(S) Then
                If IsArray(D(S)) Then
                    AR = D(S)
                    iii = UBound(AR(0)) + 1
                    For ii = 0 To UBound(AR)
                        ReDim AR1(0 To iii)
                        For i = 0 To UBound(AR1)
                            If ii = 0 Then If i < UBound(AR1) Then Set AR1(i) = AR(ii)(i) Else Set AR1(i) = xShape
                            If ii = 1 Then If i < UBound(AR1) Then AR1(i) = AR(ii)(i) Else AR1(i) = A.Text
                            If ii = 2 Then If i < UBound(AR1) Then AR1(i) = AR(ii)(i) Else AR1(i) = Sh(1).Cells(A.Row, "B").Text
                        Next
                        AR(ii) = AR1
                    Next
                    D(S) = AR
                Else
                    D(S) = Array(Array(xShape), Array(A.Text), Array(Sh(1).Cells(A.Row, "B").Text))
                End If
            Else
                D(S) = Array(Array(xShape), Array(A.Text), Array(Sh(1).Cells(A.Row, "B").Text))
            End If
        Else
            If Not D.EXISTS(S) Then D(S) = False
        End If
Net:
    Next
    ComBo.Clear
    If D.Count > 0 Then ComBo.List = D.KEYS
End Sub
Private Function ¹Ï¤ùÀˬd(xPicture As String) As Object
    Dim S As Shape
     Set ¹Ï¤ùÀˬd = Nothing
    For Each S In Sh(1).Shapes
        '*************************************************
        'Shapeª«¥ó¬O·Ó¤ù¥B¦ì¸m¬OD(ComboBox1.Value).Address)
        If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
            Set ¹Ï¤ùÀˬd = S
            Exit For
        End If
        '***************************************************
    Next
End Function
Private Sub ·Ó¤ùExport(P As Object, xName As String)
    If xName <> "D:\temp.jpg" Then
        P.CopyPicture
    Else
        P.Copy
    End If
    With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '·s¼W¹Ïªí
        .Chart.Paste '¶K¤W¹Ï¤ù
        .Chart.Export xName '¶×¥X¹Ïªí¡A¼È¦s¹Ï¤ù
        .Delete '§R°£¹Ïªí
     End With
End Sub

¥i¥H½Ð°Ý坂¤j GBKEE ¶Ü?  ³o¬O«Ü¤[¥H«e±zÀ°¦£¼gªºVBA ¡A¦ý2010¤Î2016 Excel ª©VBA ªí³æ³£¶]¤£¥X¨Ó¤F¡C ...
jeffrey628litw µoªí©ó 2019-5-22 13:49



    ½Ð°Ý¥Î EXCEL 2010¥H¤Wª©¥»¶}±ÒVBAªí³æ·|Åܦ¨§ì¤£¥X¹Ï®×¡G¦p¤U¹Ï
2010 VBA ²y­û¥d¹Ï¤ùÀɮתí³æ§ì¤£¨ì¸ê®Æ.jpg
2019-10-16 16:05


½Ð°Ý³o¬O­n§ï³o¥H¤U¶Ü?¡G(§Úª¦¤åªº)

2016ª© ³]©w  myCN.Provider = "Microsoft.Jet.OLEDB.4.0"   
¥i¬d¬Ý https://social.msdn.microsoft.co ... b40-32bit-and-64bit
§Ú³Ì°ªª©¥»2010 ³]¬°   .Provider = "Microsoft.ACE.OLEDB.12.0"

TOP

        ÀR«ä¦Û¦b : ¦³®É·í«äµL®É­W¡A¦n¤Ñ­n¿n«B¨Ó³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD