Comparar lo copiado en portapapeles con celda activa

[shamank]

Muy buenas. Espero que puedan ayudarme con lo siguiente.

Mi macro crea carpetas segun el rango que seleccione, las carpetas tienen el nombre de cada celda. Dentro de cada carpeta se crean 5 carpetas mas con nombres que yo defini (1,2,3,4,5). (Esto ya lo termine)

---------------------------------------------------------------------------------------------------------------------------------

Requiero lo siguiente

1.- Mediante eventos de click movere el cursor a una posición, dará doble click y se seleccionara un texto. (Esto ya lo he hecho)

Private Sub DoubleClick()

'Double click as a quick series of two clicks

SetCursorPos 200, 100 'x and y position

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

End Sub

Lo siguiente es copiar al portapapeles lo que selecciono anteriormente.

Posteriormente se tomara una impresion de pantalla y se hara una comparación, si lo que se guardo en el portapapeles es igual al nombre del primer valor de la celda. entonces la impresion de pantalla se guardara como imagen dentro de la carpeta con el nombre de la primer celda en la carpeta 1, la impresion debe tener el nombre de la celda

---------------------------------------------------------------------------------------------------------------------------------

Codigo para tomar el valor del portapapeles y ponerlo en una variable "Contenido", con esto pretendo comparar si Contenido = a el nombre de la celda, se guarde la imagen dentro de esa carpeta

Dim miPortapapeles As New DataObject, Contenido As String

miPortapapeles.GetFromClipboard: On Error Resume Next

Contenido = miPortapapeles.GetText

If Err Then MsgBox "Portapapeles vacio !!!" Else TextBox1 = Contenido

End Sub

Muchisimas gracias por sus prontas respuestas.

Macro con la que creo mis carpetas

Sub Crear_carpetas()

On Error Resume Next

Application.ScreenUpdating = False

contador = 0

Set fso = CreateObject("Scripting.FileSystemObject")

ruta = "C:\Users\paola\Documents\"

Range("A1").Select

Do While Not IsEmpty(ActiveCell)

Item = ActiveCell.Value

If Len(Item) = 1 Then

Item = "0" & Item

End If

ActiveCell.Offset(0, 1).Select

Codigo = ActiveCell.Value

ActiveCell.Offset(0, 1).Select

Nombre = ActiveCell.Value

Carpeta = Item & "-" & Codigo & "-" & Nombre

If Not fso.FolderExists(ruta & "\" & Carpeta) Then

fso.createfolder (ruta & "\" & Carpeta)

contador = contador + 1

End If

If fso.FolderExists(ruta & "\" & Carpeta) Then

fso.createfolder (ruta & "\" & Carpeta & "\1")

fso.createfolder (ruta & "\" & Carpeta & "\2")

fso.createfolder (ruta & "\" & Carpeta & "\3")

fso.createfolder (ruta & "\" & Carpeta & "\4")

fso.createfolder (ruta & "\" & Carpeta & "\5")

End If

ActiveCell.Offset(1, -2).Select

Loop

Respuesta = MsgBox("Se han creado " & contador & " carpetas", 64, "Número de Carpetas")

Set fso = Nothing

Application.ScreenUpdating = True

End Sub