(vba) Recorrer celdas copiadas en el clipboard

solución:

Option Explicit

Private DataObj As New MSForms.DataObject

Sub CopyForMerge()
Set DataObj = New MSForms.DataObject

Dim range As range
Set range = Selection.range(Selection.address)

Dim iniRow As Integer
Dim iniCol As Integer
Dim endRow As Integer
Dim endCol As Integer

iniRow = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(0)
iniCol = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(1) - 1
endRow = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(2)
endCol = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(3) - 1

Dim i As Integer
Dim j As Integer

For i = iniRow To endRow
For j = iniCol To endCol
DataObj.SetText Cells(i, j).text, "JLF|" & i - iniRow & "|" & j
- iniCol
Next j
Next i
End Sub

Sub PasteForMerge()
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
x = 0
y = 0

Dim exist As Boolean

For i = Selection.row To Selection.row + 10
For j = Selection.column To Selection.column + 10
exist = DataObj.GetFormat("JLF|" & x & "|" & y)
If exist = True Then
Do While IsMergedHide(j, i)
j = j + 1
Loop
Cells(i, j).Value = DataObj.GetText("JLF|" & x & "|" & y)
Debug.Print DataObj.GetText("JLF|" & x & "|" & y)
Else
Exit For
End If
y = y + 1
Next j
x = x + 1
y = 0
exist = DataObj.GetFormat("JLF|" & x & "|" & y)
If exist = False Then
Exit For
End If
Next i
End Sub

Function IsMergedHide(column As Integer, row As Integer)
If Cells(row, column).MergeCells Then
Dim rowIni As Integer
Dim columnIni As Integer
'Dim rowFin As Integer
'Dim columnFin As Integer

Dim address As String
address = Replace(Replace(Replace(Cells(row,
column).MergeArea.address(False, False, xlR1C1), "R", ""), "C", ""), "[", "")
rowIni = Split(Split(address, ":")(0), "]")(0) + 1
columnIni = Split(Split(address, ":")(0), "]")(1) + 1
'rowFin = Split(Split(address, ":")(1), "]")(0) + 1
'columnFin = Split(Split(address, ":")(1), "]")(1) + 1

If column = columnIni And row = rowIni Then
IsMergedHide = False
Else
IsMergedHide = True
End If
Else
IsMergedHide = False
End If
End Function

hola, jose !

solucion:

interesente... podrias comentar donde conseguiste este codigo (para poder analizar "el contexto")
si olvidar que la "pega" sigue estando si nos sujetamos a tu comentario (en tu segundo menssje) de que...
"Yo necesito el copy comun del usuario." (???)

saludos,
hector.

__ el codigo expuest __

Option Explicit

Private DataObj As New MSForms.DataObject

Sub CopyForMerge()
Set DataObj = New MSForms.DataObject

Dim range As range
Set range = Selection.range(Selection.address)

Dim iniRow As Integer
Dim iniCol As Integer
Dim endRow As Integer
Dim endCol As Integer

iniRow = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(0)
iniCol = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(1) - 1
endRow = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(2)
endCol = Split(Replace(Replace(Replace(Replace(range.address(0, 0,
xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(3) - 1

Dim i As Integer
Dim j As Integer

For i = iniRow To endRow
For j = iniCol To endCol
DataObj.SetText Cells(i, j).text, "JLF|" & i - iniRow & "|" & j
- iniCol
Next j
Next i
End Sub

Sub PasteForMerge()
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
x = 0
y = 0

Dim exist As Boolean

For i = Selection.row To Selection.row + 10
For j = Selection.column To Selection.column + 10
exist = DataObj.GetFormat("JLF|" & x & "|" & y)
If exist = True Then
Do While IsMergedHide(j, i)
j = j + 1
Loop
Cells(i, j).Value = DataObj.GetText("JLF|" & x & "|" & y)
Debug.Print DataObj.GetText("JLF|" & x & "|" & y)
Else
Exit For
End If
y = y + 1
Next j
x = x + 1
y = 0
exist = DataObj.GetFormat("JLF|" & x & "|" & y)
If exist = False Then
Exit For
End If
Next i
End Sub

Function IsMergedHide(column As Integer, row As Integer)
If Cells(row, column).MergeCells Then
Dim rowIni As Integer
Dim columnIni As Integer
'Dim rowFin As Integer
'Dim columnFin As Integer

Dim address As String
address = Replace(Replace(Replace(Cells(row,
column).MergeArea.address(False, False, xlR1C1), "R", ""), "C", ""), "[", "")
rowIni = Split(Split(address, ":")(0), "]")(0) + 1
columnIni = Split(Split(address, ":")(0), "]")(1) + 1
'rowFin = Split(Split(address, ":")(1), "]")(0) + 1
'columnFin = Split(Split(address, ":")(1), "]")(1) + 1

If column = columnIni And row = rowIni Then
IsMergedHide = False
Else
IsMergedHide = True
End If
Else
IsMergedHide = False
End If
End Function

hola (de nuevo), jose !

solucion:

interesente... podrias comentar donde conseguiste este codigo (para poder analizar "el contexto") ?
si olvidar que la "pega" sigue estando si nos sujetamos a tu comentario (en tu segundo menssje) de que...
"Yo necesito el copy comun del usuario." (???)

haciendo pruebas "cortas" con los inicios del codigo que expones, podrias adelgazar la obtencion de las variables si cambias:

de esto:
Dim myRange As Range, iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
Set myRange = Selection.Range(Selection.Address)
iniRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(0)
iniCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(1) - 1
endRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(2)
endCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(3) - 1

a esto:
Dim iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
With Selection
iniRow = .Row
iniCol = .Column
endRow = .Rows.Count + .Row - 1
endCol = .Columns.Count + .Column - 1
End With

aparte de que trae algunas inconsistencias y no funciona cuando la celda inicial esta en la fila1/columna1 (entre otros)

pero como te comentaba: haria falta conocer "el contexto" del tema donde encontraste este codigo (?)

saludos,
hector.

Contexto: http://tinyurl.com/mexxes

Hola Héctor, te comento que yo programé el código. Le hice algunos cambios
más:

a)

Private Sub Workbook_Open()
Application.OnKey "^c", "CopyForMerge"
Application.OnKey "^v", "PasteForMerge"
End Sub

b) Al CopyForMerge le agregué un Selection.Copy. Se ve que el copy de excel
y el copy del DataObject corren por dos caminos diferentes.

c) al PasteForMerge le agregué un condicional:

If Selection.MergeCells Then
hace el paste por el código que envié.
si no es es merge hace el paste común:

ActiveSheet.Paste

d) Mejoré la detección de la detección de celda inicio/fin del rango:

iniRow = Selection.EntireRow.row
iniCol = Selection.EntireColumn.column
endRow = iniRow + Selection.rows.Count - 1
endCol = iniCol + Selection.columns.Count - 1


De esa forma el usuario hace "copy/paste" y usa mi código, ya que no pude
hacer lo del "Yo necesito el copy comun del usuario."


http://tinyurl.com/mexxes



"Héctor Miguel" wrote:

hola (de nuevo), jose !

>> solucion:
>
> interesente... podrias comentar donde conseguiste este codigo (para poder analizar "el contexto") ?
> si olvidar que la "pega" sigue estando si nos sujetamos a tu comentario (en tu segundo menssje) de que...
> "Yo necesito el copy comun del usuario." (???)

haciendo pruebas "cortas" con los inicios del codigo que expones, podrias adelgazar la obtencion de las variables si cambias:

de esto:
Dim myRange As Range, iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
Set myRange = Selection.Range(Selection.Address)
iniRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(0)
iniCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(1) - 1
endRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(2)
endCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(3) - 1

a esto:
Dim iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
With Selection
iniRow = .Row
iniCol = .Column
endRow = .Rows.Count + .Row - 1
endCol = .Columns.Count + .Column - 1
End With

aparte de que trae algunas inconsistencias y no funciona cuando la celda inicial esta en la fila1/columna1 (entre otros)

pero como te comentaba: haria falta conocer "el contexto" del tema donde encontraste este codigo (?)

saludos,
hector.

gracias!! no lo había visto...y lo había solucionado con.

iniRow = Selection.EntireRow.row
iniCol = Selection.EntireColumn.column
endRow = iniRow + Selection.rows.Count - 1
endCol = iniCol + Selection.columns.Count - 1



"Héctor Miguel" wrote:

hola (de nuevo), jose !

>> solucion:
>
> interesente... podrias comentar donde conseguiste este codigo (para poder analizar "el contexto") ?
> si olvidar que la "pega" sigue estando si nos sujetamos a tu comentario (en tu segundo menssje) de que...
> "Yo necesito el copy comun del usuario." (???)

haciendo pruebas "cortas" con los inicios del codigo que expones, podrias adelgazar la obtencion de las variables si cambias:

de esto:
Dim myRange As Range, iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
Set myRange = Selection.Range(Selection.Address)
iniRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(0)
iniCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(1) - 1
endRow = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(2)
endCol = Split(Replace(Replace(Replace(Replace(myRange.Address(0, 0, xlR1C1), "R", ""), "C", ""), ":", ""), "[", ""), "]")(3) - 1

a esto:
Dim iniRow As Integer, iniCol As Integer, endRow As Integer, endCol As Integer
With Selection
iniRow = .Row
iniCol = .Column
endRow = .Rows.Count + .Row - 1
endCol = .Columns.Count + .Column - 1
End With

aparte de que trae algunas inconsistencias y no funciona cuando la celda inicial esta en la fila1/columna1 (entre otros)

pero como te comentaba: haria falta conocer "el contexto" del tema donde encontraste este codigo (?)

saludos,
hector.