Skapa datavalidering

I detta tips demonstreras hur vi i VBA kan skapa datavalidering i en eller flera celler. Tipsets andra exempel visar hur en lista i ett arbetsblad kopplas till en validering i ett annat arbetsblad.

 

Option Explicit

 Sub Add_Data_Validation()

' © 2004 Alla rättigheter XL-Dennis

  Dim wbBook As Workbook

  Dim wsTarget As Worksheet

  Dim rnTarget As Range

  Dim stList As String

  Dim vaList As Variant

  Dim i As Long

 

  vaList = VBA.Array("AA", "BB", "CC", "DD")

 

  Set wbBook = ActiveWorkbook

 

  With wbBook

    Set wsTarget = .Worksheets("Sheet1")

  End With

 

  With wsTarget

    Set rnTarget = .Range("D2")

  End With

 

  'Skapa listan.

  For i = 0 To 3

    stList = stList & vaList(i) & ","

  Next

 

  With rnTarget.Validation

    .Delete 'Ta bort tidigare lista (om nödvändigt) .

    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=stList

    .ErrorTitle = "Felaktigt värde"

    .ErrorMessage = "Du kan endast välja avdelning från listan"

  End With

End Sub

 

 

Sub Add_Data_Validation_From_Other_Worksheet()

  '© 2004 Alla rättigheter XL-Dennis

  Dim wbBook As Workbook

  Dim wsTarget As Worksheet, wsSource As Worksheet

  Dim rnTarget As Range, rnSource As Range

 

  Set wbBook = ActiveWorkbook

 

  With wbBook

    Set wsSource = .Worksheets("Sheet2")

    Set wsTarget = .Worksheets("Sheet1")

    On Error Resume Next

    .Names("Source").Delete

    On Error GoTo 0

  End With

 

  With wsSource

    'Skapa namnet för källdata.

    .Range(.Range("A2"), .Range("A65536").End(xlUp)).Name = "Source"

  End With

 

  With wsTarget

    Set rnTarget = .Range("D2")

  End With

 

  With rnTarget

    .ClearContents 'Ta bort eventuell data i cellen.

    With .Validation

      .Delete 'Ta bort tidigare lista (om nödvändigt).

      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Source"

      .ErrorTitle = "Felaktigt värde"

      .ErrorMessage = "Du kan endast välja avdelning från listan"

    End With

  End With

End Sub