Problem with object variable in vba
Posted by Thierry Verviers on November 23, 2000 7:28 AM
Hi,
I try to put a range in an object variable define like a RANGE. But each time, I obtain the value in my variable objetc. I don't understand why. Have you an idea for a solution to this problem.
My code
Public Sub CopieMultiple()
Dim SelAreas() As Range
Dim PasteRange As Range
Dim UpperLeft As Range
Dim NumAreas As Integer, I As Integer
Dim TopRow As Long, LeftCol As Integer
Dim RowOffset As Long, ColOffset As Integer
Dim NonEmptyCellCount As Integer
' Sort si une zone n'est pas sélectionnée
If TypeName(Selection) <> "Range" Then
MsgBox "Error, the multiple copypaste could not be made since no zone was selected. "
MsgBox "Erreur, la copie multiple n'a pu se faire faute de sélection."
Exit Sub
End If
' Store les différentes zones comme des objets Range
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For I = 1 To NumAreas
Set SelAreas(I) = Selection.Areas(I)
Next
' Détermine la cellule en haut à gauche des multiples sélections
TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count
For I = 1 To NumAreas
If SelAreas(I).Row < TopRow Then TopRow = SelAreas(I).Row
If SelAreas(I).Column < LeftCol Then LeftCol = SelAreas(I).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)
' Emmagasine l'adresse où aller copier qui a été passée
' 3 paramètres.
'On Error Resume Next
Set PasteRange = Workbooks("BilRN.xls").Worksheets("BilR").Range("AJ12")
If TypeName(PasteRange) <> "Range" Then MsgBox "erreur"
'On Error GoTo 0
' S'assure que seule cellule en haut à gauche est utilisée
Set PasteRange = PasteRange.Range("A1")
If TypeName(PasteRange) <> "Range" Then MsgBox "erreur"
Workbooks("BilRN.xls").Activate
'Dim resultat
'resultat = Application.Run("sef_bcs.xls!CheckActivate", "SEFProjetc:Mod2:sRechTrad" & " " & iNoRech)
' Copie et colle chaque zone sélectionnée
For I = 1 To NumAreas
RowOffset = SelAreas(I).Row - TopRow
ColOffset = SelAreas(I).Column - LeftCol
SelAreas(I).Copy PasteRange.Offset(RowOffset, ColOffset)
Next I
End Sub