Comparar lo copiado en portapapeles con celda activa
publicado
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)
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
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
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