Sub Imagen13_Haga_clic_en()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Dim rutaArchivo As String
Dim Email As CDO.Message
Dim t As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "4324"
'--- GENERAR IMAGEN DEL RECIBO ---
With Range("H7:R34")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height
.CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Activate
.Chart.Paste
'---- RUTA DEL ARCHIVO (CORREGIDO) ----
rutaArchivo = "C:\Users\Usuario\Google Drive\LOCACIONES\REC. PROPIETARIOS\" & _
Format(Range("Q20"), "mmmYY") & " - " & _
Range("Q9") & " - " & _
Range("P17") & " - " & _
Range("K19") & ".JPG"
.Chart.Export rutaArchivo
.Delete
End With
'Guardar ruta en AK30 por compatibilidad
Range("AK30").Value = rutaArchivo
'--- PEGAR BLOQUE DE DATOS ---
Range("AH6").Copy
Range("AH9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("Y7:AI33").Copy
Range("H7").PasteSpecial xlPasteAll
ActiveSheet.Protect "4324"
ActiveWorkbook.Save
'--- PREPARAR ENVÍO DEL MAIL ---
Set Email = New CDO.Message
correo_origen = "nqn.negocios@gmail.com"
Clave_correo_origen = "wkfhaapcnjljbwju"
correo_destino = Range("AK27").Value
Asunto = Range("AK28")
Mensaje = Range("AK29")
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
'--- VALIDAR ARCHIVO ANTES DE ENVIAR ---
t = Timer
Do While Dir(rutaArchivo) = "" And Timer - t < 5
DoEvents
Loop
If Dir(rutaArchivo) = "" Then
MsgBox "ERROR: El archivo no se generó: " & rutaArchivo, vbCritical
Exit Sub
End If
'--- ENVIAR MAIL ---
With Email
.To = correo_destino
.From = correo_origen
.Subject = Asunto
.TextBody = Mensaje
.Configuration.Fields.Update
.AddAttachment rutaArchivo
On Error Resume Next
.Send
End With
End Sub
Sub powerbuttonINQ()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Dim rutaArchivo As String
Dim Email As CDO.Message
Dim t As Single
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "4324"
'--- GENERAR IMAGEN DEL RECIBO ---
With Range("H7:R33")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height
.CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Activate
.Chart.Paste
rutaArchivo = "C:\Users\Usuario\Google Drive\LOCACIONES\REC. INQUILINOS\" & _
Format(Range("Q20"), "mmmYY") & " - " & _
Range("Q9") & " - " & _
Range("P17") & " - " & _
Range("J17") & ".JPG"
.Chart.Export rutaArchivo
.Delete
End With
Range("AK30").Value = rutaArchivo
Range("AH6").Copy
Range("AH9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("Y7:AI33").Copy
Range("H7").PasteSpecial xlPasteAll
ActiveSheet.Protect "4324"
ActiveWorkbook.Save
'--- EMAIL CONFIG ---
Set Email = New CDO.Message
correo_origen = "nqn.negocios@gmail.com"
Clave_correo_origen = "wkfhaapcnjljbwju"
correo_destino = Range("AK27").Value
Asunto = Range("AK28")
Mensaje = Range("AK29")
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
'--- VERIFICAR ARCHIVO ---
t = Timer
Do While Dir(rutaArchivo) = "" And Timer - t < 5
DoEvents
Loop
If Dir(rutaArchivo) = "" Then
MsgBox "ERROR: El archivo no se generó: " & rutaArchivo, vbCritical
Exit Sub
End If
'--- ENVIAR ---
With Email
.To = correo_destino
.From = correo_origen
.Subject = Asunto
.TextBody = Mensaje
.Configuration.Fields.Update
.AddAttachment rutaArchivo
On Error Resume Next
.Send
End With
End Sub
Por
JSDJSD, · publicado
Vocabulario, Glosario o Definiciones y Ayuda VBA
Las definiciones presentadas se incrementarán a media que pase el tiempo
ActiveCell.FormulaR1C1 = "Recurso" : Escribe en la celda activa "Recurso"
ActiveCell.Offset(0, 1).Select : Muevete una columna a la derecha
ActiveCell.Offset(0, -1).Select : Muevete una columna a la izquierda
ActiveCell.Offset(1, 0).Select : Muevete 1 fila hacia abajo
ActiveCell.Offset(-1, 0).Select : Muevete 1 fila hacia arriba
ActiveSheet.Paste : Pega en la Hoja activa (En la hoja q este ubicado)
ActiveWindow.DisplayGridlines = False : Ocultar el borde de las celdas
ActiveWindow.DisplayGridlines = True : Mostrar el borde de las celdas
ActiveWindow.DisplayHeadings = False : Ocultar las columnas
ActiveWindow.DisplayHeadings = True : Mostrar las columnas
ActiveWindow.WindowState = xlMaximized : Maximiza
ActiveWindow.WindowState = xlMinimized : Minimiza
ActiveWorkbook.Close : Cerrar Libro Activo
ActiveWorkbook.Save : Guardar Libro Activo
Application.CutCopyMode = False : Desahabilita copiar
Application.DisplayAlerts = False : Desacativar alertas de Excel
Application.DisplayAlerts = True : Activar alertas de Excel
Application.ScreenUpdating = False : Quitar parpadeo pantalla cuando se ejecuta la macro
Application.ScreenUpdating = True : Activar parpadeo pantalla cuando se ejecuta la macro
Call : Llamar un Procedimiento o Macro
Cells : Celda
Cells(7,2).Select : Selecciona la celda B7
Cells.Delete : Elimina todas las celdas
Cells.Select : Selecciona todas las celdas
Columns("A:I").EntireColumn.AutoFit : Margen automático desde las columnas A a la I
Columns("D:D").Select : Selecciona la Columna D
Hoja1.Name = "Inventario" : El nombre de la Hoja1 será "Inventario"
Hoja1.Visible = xlSheetVisible : Muestra la Hoja1
Hoja1.Visible =xlSheetHidden : Oculta la Hoja1
Hoja2.Cells(1, 3) = "Cantidad" : Escribe en la celda C1 "Cantidad"
Hoja2.select : Selecciona la Hoja2
Range : Rango
Range("A2:F2").Select : Selecciona de la celda A2 a la F2
Range("B7").Select : Selecciona la celda B7
Select : Seleccionar
Selection.ClearContents : Limpiar contenido o información de la celda
Selection.Copy : Copiar selección
Selection.Cut : Cortar selección
Selection.EntireColumn.Delete : Elimina la columna selecciona
Selection.Font.Bold = True : Selecciona y pone la letra en Negrita
Selection.NumberFormat = "#,##0.00" : El formato seleccionado númerico es 20.000,54
Sheets("Hoja2").select : Selecciona la Hoja2
Hoja2.select : Selecciona la Hoja2
Windows("Macros Excel.xls").Activate : Selecciona o Activa el libro "Macros Excel.xls"
Alinear el contenido al Centro With Selection
: .HorizontalAlignment = xlCenter
End With
Alinear el contenido al Izquierda With Selection
: .HorizontalAlignment = xlLeft
End With
Alinear el contenido al Derecha With Selection
: .HorizontalAlignment = xlRight
End With
MsgBox : Mensaje
MsgBox Configuración : MsgBox Mensaje, Icono, Titulo
InputBox : Caja de Texto para Introducir valores con Aceptar y Cancelar
Empty : Limpiar
End Sub