Renombrar Fotos

Solo consultas sobre macros y código VBA Excel.

Reglas del Foro
1. Antes de hacer tu pregunta intenta con el buscador de este foro (muchas preguntas ya fueron respondidas antes!)
2. Si haces una nueva pregunta, es muy recomendable que adjuntes el ejemplo Excel para poder comprenderla mejor!
3. Realiza tu pregunta de forma clara, explicando bien cada paso de lo que haces y tendrás más probabilidad de respuesta!
Compartir en:
     

Renombrar Fotos

Notapor wechavarriam » 09 Mar 2010 12:58

Hola amigos....les pido el grandisimo favor, como hago para renombrar fotos de un listado de registros el cual no coinside el orden con el nombre de las fotos el cual tiene asignado, el punto es que debe de ir a la carpeta y buscar la foto entre las N fotos que haya y renombrarla...por favor colaborenme con esto...gracias.
No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
wechavarriam
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Feb 2010 17:00

Re: Renombrar Fotos

Notapor Antoni » 09 Mar 2010 14:26

Hola:

Me parece que tengo algo parecido.

Mañana te digo alguna cosa.

Saludos

Antoni
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Antoni
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Dic 2009 04:58
Ubicación: GALICIA (ESPAÑA)

Re: Renombrar Fotos

Notapor Tokenring » 09 Mar 2010 16:12

Buenas Tardes:

Primero se debe agregar la referencia Microsoft Scripting 2.0 Object Library (Herramientas, Agregar Referencia)

Después tengo un método para modificar los archivos

Sub Buscar_Renombrar(Ruta As String)
Dim fso As FileSystemObject
Dim carpeta As Folder

Set fso = New FileSystemObject
Set carpeta = fso.GetFolder(Ruta)
Set Archivos = carpeta.Files

For Each archivo In Archivos
Select Case archivo.Name
Case "5004.jpg"
Name archivo.Path As Ruta & "5.jpg"
Case "3005.jpg"
Name archivo.Path As Ruta & "1.jpg"
Case "2002.jpg"
Name archivo.Path As Ruta & "3.jpg"
Case "1006.jpg"
Name archivo.Path As Ruta & "2.jpg"
Case "4032.jpg"
Name archivo.Path As Ruta & "4.jpg"
End Select
Next archivo
MsgBox "Se han renombrado los archivos!"
End Sub

Finalmente lo llamo (Tu carpeta la copie en C:\)

Private Sub Cambiar_Nombre_Click()
Buscar_Renombrar "C:\RenombrarFotos\"
End Sub

Espero te sea de utilidad
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Tokenring
Miembro Frecuente
Miembro Frecuente
 
Registrado: 03 Mar 2010 14:41
Ubicación: Mexico

Re: Renombrar Fotos

Notapor Tokenring » 09 Mar 2010 16:23

Perdon, la referencia que se debe agregar es: Microsoft Scripting Runtime
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Tokenring
Miembro Frecuente
Miembro Frecuente
 
Registrado: 03 Mar 2010 14:41
Ubicación: Mexico

Re: Renombrar Fotos

Notapor Antoni » 10 Mar 2010 05:46

Hola:

Aprovechando la idea de Tokenring , te adjunto la macro RENOMBRAR_ARCHIVOS que hace lo siguiente:

Renombra todos los archivos de la columna 1 con el nombre de la columna 2, y deja un indicador del resultado de la operación en la columna 3 ("OK"= Operación correcta, " "=Archivo no encontrado)

Código: Seleccionar todo
Dim Objeto_Ficheros As Object
Dim Lista_Ficheros As Object
Dim Ficheros As Object
Dim Fichero As Object

Sub RENOMBRAR_ARCHIVOS()
'--------------------------------------------------------------
Set Objeto_Ficheros = CreateObject("Scripting.FileSystemObject")
Set Lista_Ficheros = Objeto_Ficheros.GetFolder(ThisWorkbook.Path & "\")
Set Ficheros = Lista_Ficheros.Files
'--------------------------------------------------------------
x = 1
While ActiveSheet.Cells(x, 1) <> ""
    If ActiveSheet.Cells(x, 3) <> "OK" Then
       For Each Fichero In Ficheros
           If UCase(Fichero) = UCase(ThisWorkbook.Path & "\" & ActiveSheet.Cells(x, 1)) Then
              Fichero.Copy ThisWorkbook.Path & "\" & ActiveSheet.Cells(x, 2), True
              Fichero.Delete
              ActiveSheet.Cells(x, 3) = "OK"
              Exit For
           End If
       Next
    End If
x = x + 1
Wend
End Sub

Nota: El libro que contenga esta macro y los archivos a renombrar, deben estar en el mismo directorio

Salu2 a to2....to2

Antoni
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Antoni
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Dic 2009 04:58
Ubicación: GALICIA (ESPAÑA)

Re: Renombrar Fotos

Notapor wechavarriam » 11 Mar 2010 05:33

Muhcas gracias a ambos Tokenring y Antoni pero le pregunto a Tokenring en tu ejemplo utilizas CASE pero en modo ejemplo coloque estas 5 fotos, como le hago cuando no sean 5 sino N FOTOS (cantidad no defininda de fotos a renombrar), disculpa que les pregunte nuevamente pero es que soy novato y no logro ponerlo a funcionar......por su antencion a ambos mil gracias.
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
wechavarriam
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Feb 2010 17:00

Re: Renombrar Fotos

Notapor Antoni » 11 Mar 2010 05:50

Hola:

Ayer decía:
Aprovechando la idea de Tokenring , te adjunto la macro RENOMBRAR_ARCHIVOS que hace lo siguiente:

Renombra todos los archivos de la columna 1 con el nombre de la columna 2, y deja un indicador del resultado de la operación en la columna 3 ("OK"= Operación correcta, " "=Archivo no encontrado)

Además de novato, no lees lo que te contestan

Mi respuesta, hace exactamente lo que pides.

Salu2

Antoni
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Antoni
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Dic 2009 04:58
Ubicación: GALICIA (ESPAÑA)

Re: Renombrar Fotos

Notapor wechavarriam » 12 Mar 2010 04:44

Hola Antoni.....disculpa mi falta de atencion, esta muy bien, muchas gracias.
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
wechavarriam
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Feb 2010 17:00

Re: Renombrar Fotos

Notapor sach » 20 Ene 2011 06:57

Hola, Antoni gracias por el código a mi me ha ayudado mucho; ya que mis conocimientos de VBA son casi nulos.
Tengo un problema, sabrías decirme como hacer lo mismo pero teniendo en una columna la ruta de los ficheros. Yo tengo que renombrar unos mil archivos pero en diferentes carpetas.
Gracias, un saludo
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
sach
Miembro Nuevo
Miembro Nuevo
 
Registrado: 18 Ene 2011 12:57

Re: Renombrar Fotos

Notapor Antoni » 20 Ene 2011 12:48

Hola sach:

Te adjunto archivo con una macro para renombrar ficheros de distintos directorios.

Saludos.
No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Avatar de Usuario
Antoni
Miembro Frecuente
Miembro Frecuente
 
Registrado: 22 Dic 2009 04:58
Ubicación: GALICIA (ESPAÑA)

Re: Renombrar Fotos

Notapor sach » 20 Ene 2011 14:20

Hola Antoni

Gracias, funciona de maravilla me has salvado...... Creo que ni en cien años lo sacaría. He puesto:

Sub RenombrarFicheros()
Application.ScreenUpdating = False
Range("A2").Activate
Do Until ActiveCell = ""
Application.StatusBar = ActiveCell & ActiveCell.Offset(0, 1) & " por " & ActiveCell.Offset(0, 2)
ActiveCell.Offset(0, 3) = "Error"
On Error GoTo Notfound
Name ActiveCell & ActiveCell.Offset(0, 1) As ActiveCell & ActiveCell.Offset(0, 2)
ActiveCell.Offset(0, 3) = "OK"
Notfound:
ActiveCell.Offset(1, 0).Activate
Loop
Application.StatusBar = ""
End Sub
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
sach
Miembro Nuevo
Miembro Nuevo
 
Registrado: 18 Ene 2011 12:57

Re: Renombrar Fotos

Notapor chicharin » 22 Jun 2011 19:54

Que tal, un saludote desde México....Navegando un buen rato me encontre con este foro y quiero agradecer la macro que publico Antoni, corre de lujo y en lo personal me ayudo bastante, ademas veo que tienen un buen de temas por lo que seguramente no sera la unica vez que estemos en contacto.
Saludos y gracias de nueva cuenta.
:D
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
chicharin
Miembro Nuevo
Miembro Nuevo
 
Registrado: 22 Jun 2011 19:17

Re: Renombrar Fotos

Notapor almos » 08 Oct 2013 14:19

Yo tambien quiero daros las gracias. Me ha servido de mucho el ejemplo que habeis adjuntado.

saludos desde España.
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
almos
Miembro Nuevo
Miembro Nuevo
 
Registrado: 08 Oct 2013 14:01

Re: Renombrar Fotos

Notapor dannisjor » 19 Nov 2013 17:13

Muchas gracias, buenazo el macro!!!
Saludos
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
dannisjor
Miembro Nuevo
Miembro Nuevo
 
Registrado: 19 Nov 2013 09:57

Re: Renombrar Fotos

Notapor Warcraft » 25 Nov 2013 14:20

Enhorabuena por la macro
* Te recomendamos estos productos Excel: Manual de Macros | Manual de Funciones | Nuevas Funciones | ddTraDa
Warcraft
Miembro Frecuente
Miembro Frecuente
 
Registrado: 24 Feb 2006 09:10
Ubicación: Madrid


Compartir en:
     

  • Anuncio
Manual Excel avanzado

Volver a Macros

¿Quién está conectado?

Usuarios navegando por este Foro: Antoni, karmelihobbyt y 4 invitados