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 el 5 de diciembre 5 dic
Hola buenas tardes ojala haya alguien que me pueda ayudar, tengo un archivo en el cual tengo un Userform que realiza vaciado de datos en las celdas que indíco y asu vez cálculos. Pero al finalizar no me toma llamar Call Condicional_Else2, cada que pongo otra condición al finalizar no la toma en cuenta. cual será el problema en esta macro?. Saludos.
Sheets("Factura Carta").Activate
Range("C23:M36").Select
Selection.ClearContents
Range("C23").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox2
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox3
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox4
Range("C24").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox8
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox9
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox10
Range("C25").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox14
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox15
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox16
Range("C26").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox20
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox21
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox22
Range("C27").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox26
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox27
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox28
Range("C28").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox32
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox33
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox34
Range("C29").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox38
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox39
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox40
Range("C30").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox44
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox45
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox46
Range("C31").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox50
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox51
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox52
Range("C32").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox56
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox57
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox58
Range("C33").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox62
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox63
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox64
Range("C34").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox68
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox69
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox70
Range("C35").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox74
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox75
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox76
Range("C36").Select
ActiveCell.Offset(0, 0).Value = UserForm14.TextBox80
ActiveCell.Offset(0, 2).Value = UserForm14.TextBox81
ActiveCell.Offset(0, 3).Value = UserForm14.TextBox82
If TextBox5 = "" Then
Range("M23").Value = UserForm14.TextBox5.Value
ElseIf TextBox5 >= 0 Then
Range("M23").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox5 / 1.16
If TextBox11 = "" Then
Range("M24").Value = UserForm14.TextBox11.Value
ElseIf TextBox11 >= 0 Then
Range("M24").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox11 / 1.16
If TextBox17 = "" Then
Range("M25").Value = UserForm14.TextBox17.Value
ElseIf TextBox17 >= 0 Then
Range("M25").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox17 / 1.16
If TextBox23 = "" Then
Range("M26").Value = UserForm14.TextBox23.Value
ElseIf TextBox23 >= 0 Then
Range("M26").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox23 / 1.16
If TextBox29 = "" Then
Range("M27").Value = UserForm14.TextBox29.Value
ElseIf TextBox29 >= 0 Then
Range("M27").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox29 / 1.16
If TextBox35 = "" Then
Range("M28").Value = UserForm14.TextBox35.Value
ElseIf TextBox35 >= 0 Then
Range("M28").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox35 / 1.16
If TextBox41 = "" Then
Range("M29").Value = UserForm14.TextBox41.Value
ElseIf TextBox41 >= 0 Then
Range("M29").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox41 / 1.16
If TextBox47 = "" Then
Range("M30").Value = UserForm14.TextBox47.Value
ElseIf TextBox47 >= 0 Then
Range("M30").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox47 / 1.16
If TextBox53 = "" Then
Range("M31").Value = UserForm14.TextBox53.Value
ElseIf TextBox53 >= 0 Then
Range("M31").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox53 / 1.16
If TextBox59 = "" Then
Range("M32").Value = UserForm14.TextBox59.Value
ElseIf TextBox59 >= 0 Then
Range("M32").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox59 / 1.16
If TextBox65 = "" Then
Range("M33").Value = UserForm14.TextBox65.Value
ElseIf TextBox65 >= 0 Then
Range("M33").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox65 / 1.16
If TextBox71 = "" Then
Range("M34").Value = UserForm14.TextBox71.Value
ElseIf TextBox71 >= 0 Then
Range("M34").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox71 / 1.16
If TextBox77 = "" Then
Range("M35").Value = UserForm14.TextBox77.Value
ElseIf TextBox77 >= 0 Then
Range("M35").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox77 / 1.16
If TextBox83 = "" Then
Range("M36").Value = UserForm14.TextBox83.Value
ElseIf TextBox83 >= 0 Then
Range("M36").Select
ActiveCell.FormulaR1C1 = UserForm14.TextBox83 / 1.16
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Exit Sub
End If
Call Condicional_Else2
End Sub