Excel VBA中的动态命名范围

时间:2018-12-18 10:13:04

标签: excel vba excel-vba

我正在尝试将excel中的命名范围从一张纸复制到另一张纸,当我使用静态名称时,这种方法效果很好。但是,现在我想从用户窗体列表框中获取命名范围,但我不确定如何执行此操作。我的复制函数接受行号,我需要根据来自列表框的字符串找到此行号。如果列表框显示“螺栓”,则命名范围将是_OutputBolts,它引用了A123。

    Call copyRows(ws, ThisWorkbook.Sheets("Templates").[_DrawingInputs].Row)
    Call copyRows(ws, ThisWorkbook.Sheets("Templates").[_GeneralInputs].Row)
    Call copyRows(ws, ThisWorkbook.Sheets("Templates").[_MaterialData].Row)

If GUI.ListBox_AdditionalComponents.ListCount > 0 Then
        For i = 0 To GUI.ListBox_AdditionalComponents.ListCount - 1
            namedRange = "[_Output" & GUI.ListBox_AdditionalComponents.List(i) & "]"
            Call copyRows(ws, ThisWorkbook.Sheets("Templates").namedRange.Row)
        Next i
    End If

复制过程

Public Sub copyRows(ByRef shNew As Worksheet, startRow As Integer)
    Dim i, j As Integer
    Dim wsTemplates As Worksheet
    Dim temp As Variant
    Dim rowOverview As Integer
    Dim lastCol As Integer

    On Error Resume Next

    Set wsTemplates = ThisWorkbook.Sheets("Templates")


    i = startRow ' Where to copy from in templates

    j = getLastRow(shNew, 1) 'Where to copy to, i.e append
    If j > 2 Then
        j = j + 2
    End If


    Do While wsTemplates.Cells(i, 1) <> ""
        'copy the old range
        wsTemplates.Rows(i).EntireRow.Copy
        'paste it
        shNew.Rows(j).EntireRow.Select
        shNew.Paste

        'format height
        temp = wsTemplates.Rows(i).Height
        shNew.Rows(j).RowHeight = CInt(temp)


        ' fill in the value from the GUI
        temp = ""
        temp = GUI.Controls("TextBox_" & Replace(shNew.Cells(j, 1).value, " ", "")).value

        If temp = "" Then
            temp = GUI.Controls("ComboBox_" & Replace(shNew.Cells(j, 1).value, " ", "")).value
        End If


        If temp <> "" Then
            shNew.Cells(j, 4).value = temp
        End If

        'hyperlink drawing
        If shNew.Cells(j, 1).value = "Drawing Name" Then
           Call createHyperLink(shNew, j, 4, shNew.Cells(j, 4).value, GetFileNameWithOutExtension(getFilenameFromPath(shNew.Cells(j, 4).value)), shNew.Cells(j, 4).value)
        End If

        'update counters
        i = i + 1
        j = j + 1
    Loop


    ' Format column widths, seems to be bug in this one...Maybe move out due to the fact we could do this once..
    lastCol = getLastColumn(wsTemplates, 1)

    For i = 1 To lastCol
        temp = wsTemplates.Cells(1, i).Width
        shNew.Columns(i).ColumnWidth = temp
    Next i

End Sub

通过使用范围(地址)解决,请参见注释

0 个答案:

没有答案