Wps VBA编程问题

Question

您好，我遇到一个问题，我想用VBA编程做一个自动更新和自动同步的功能，但是，我发现我总不能输出相应的行；然后显示图片显示的问题；您能帮我找一下原因吗？

Private nextLeft As Double
Private nextTop As Double
 
Private Sub UserForm_Initialize()
    ' 初始化位置
    nextLeft = 10
    nextTop = 100 ' 调整初始位置以腾出顶部空间用于输入源表信息
End Sub
 
Private Sub btnAddControls_Click()
    AddControls
End Sub
 
Private Sub AddControls()
    ' 计算现有控件数量，减去初始的6个控件：两个标签、两个文本框、两个按钮
    Dim ctrlIndex As Integer
    ctrlIndex = (Me.Controls.Count - 6) / 2 + 1
    
    ' 添加复合框
    Dim comboBox As MSForms.comboBox
    Set comboBox = Me.Controls.Add("Forms.ComboBox.1", "comboBox" & ctrlIndex, True)
    With comboBox
        .Left = nextLeft
        .Top = nextTop
        .Width = 100
        .Height = 20
    End With
    
    ' 填充复合框内容
    Dim tableNames As Collection
    Set tableNames = GetTableNames()
    Dim i As Integer
    For i = 1 To tableNames.Count
        comboBox.AddItem tableNames(i)
    Next i
    
    ' 添加文本框
    Dim textBox As MSForms.textBox
    Set textBox = Me.Controls.Add("Forms.TextBox.1", "textBox" & ctrlIndex, True)
    With textBox
        .Left = nextLeft + 110
        .Top = nextTop
        .Width = 100
        .Height = 20
    End With
    
    ' 更新下一个控件的位置
    If nextLeft + 220 > Me.InsideWidth Then
        ' 如果超出宽度，则换行
        nextLeft = 10
        nextTop = nextTop + 30
    Else
        ' 否则向右移动
        nextLeft = nextLeft + 220
    End If
End Sub
 
Private Function GetTableNames() As Collection
    Dim ws As Worksheet
    Set GetTableNames = New Collection
    For Each ws In ThisWorkbook.Worksheets
        GetTableNames.Add ws.Name
    Next ws
End Function
 
Private Sub btnFetchData_Click()
    AutoFillData
End Sub
 
Private Sub AutoFillData()
    Dim sourceSheet As Worksheet
    Dim sourceRange As Range
    Dim targetSheet As Worksheet
    Dim targetColumn As Range
    Dim nextEmptyCell As Range
    Dim ctrl As Control
    Dim comboBox As MSForms.comboBox
    Dim textBox As MSForms.textBox
    Dim sourceCell As Range
    
    ' 获取源表和源区域
    On Error Resume Next
    Set sourceSheet = ThisWorkbook.Sheets(Me.txtSourceSheet.Text)
    Set sourceRange = sourceSheet.Range(Me.txtSourceRange.Text)
    On Error GoTo 0
    
    If sourceSheet Is Nothing Or sourceRange Is Nothing Then
        MsgBox "请检查源表名称和源区域输入是否正确。", vbExclamation
        Exit Sub
    End If
    
    ' 遍历所有控件
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ComboBox" And Left(ctrl.Name, 8) = "comboBox" Then
            Set comboBox = ctrl
            ' 解析出对应的文本框名称
            Dim textBoxName As String
            textBoxName = "textBox" & Mid(comboBox.Name, 9)
            
            ' 找到对应的文本框
            On Error Resume Next
            Set textBox = Me.Controls(textBoxName)
            On Error GoTo 0
            
            If textBox Is Nothing Then
                MsgBox "找不到对应的文本框：" & textBoxName, vbExclamation
            Else
                ' 检查目标表和目标列是否有效
                If comboBox.Value <> "" And textBox.Text <> "" Then
                    On Error Resume Next
                    Set targetSheet = ThisWorkbook.Sheets(comboBox.Value)
                    Set targetColumn = targetSheet.Range(textBox.Text)
                    On Error GoTo 0
                    
                    If targetSheet Is Nothing Or targetColumn Is Nothing Then
                        MsgBox "请检查目标表名称和目标列输入是否正确。", vbExclamation
                    Else
                        ' 复制数据到目标列
                        For Each sourceCell In sourceRange
                            If Not IsEmpty(sourceCell.Value) Then
                                Set nextEmptyCell = targetColumn.Cells(targetColumn.Cells.Count).End(xlUp).Offset(1, 0)
                                nextEmptyCell.Value = sourceCell.Value
                            End If
                        Next sourceCell
                    End If
                End If
            End If
        End If
    Next ctrl
End Sub
 
Sub ShowAddControlsForm()
    UserForm1.Show
End Sub
 
 
 

Answer 1

以下回复参考：皆我百晓生、券券喵儿等免费微信小程序作答:

从您提供的代码来看，您已经实现了一个UserForm，用于添加源表和目标表的组合框以及目标列的文本框。然后，当用户点击“确定”按钮时，程序会遍历所有控件，获取源表、源区域、目标表和目标列的信息，并将源区域的数据复制到目标列。

关于您提到的两个问题：

1. 无法输出相应的行：这个问题可能是由于在复制数据时，没有正确地找到下一个空单元格。您可以尝试使用以下代码替换原有的AutoFillData子程序中的相关部分：

' 复制数据到目标列
For Each sourceCell In sourceRange
    If Not IsEmpty(sourceCell.Value) Then
        Set nextEmptyCell = targetColumn.Cells(targetColumn.Cells.Count).End(xlUp).Offset(1, 0)
        nextEmptyCell.Value = sourceCell.Value
    End If
Next sourceCell

这段代码会在每次循环中查找目标列的最后一个非空单元格，并在其后插入新的单元格，然后将源单元格的值复制到新单元格中。这样可以确保数据按预期的方式复制到目标列。

1. 显示图片显示的问题：这个问题可能是由于UserForm的设计问题导致的。请检查UserForm的属性设置，确保其大小和位置适合您的屏幕分辨率。此外，如果您需要在UserForm上显示图片，可以使用Image控件来添加图片。例如：

Private Sub UserForm_Initialize()
    ' 添加图片控件
    Dim img As MSForms.Image
    Set img = Me.Controls.Add("Forms.Image.1", "imgPicture", True)
    With img
        .Left = 10
        .Top = 10
        .Width = 100
        .Height = 100
        .Picture = "C:\path\to\your\picture.jpg" ' 替换为您的图片路径
    End With
End Sub

这段代码将在UserForm的左上角添加一个名为imgPicture的图片控件，并设置其大小和图片路径。您可以根据需要调整这些值。