Apache OpenOffice: Foro oficial de la comunidad

Código: Seleccionar todo

Sub EnviarEmail()
	' Declaramos variables
	Dim OutlookApp As Outlook.Application
	Dim MItem As Outlook.MailItem
	Dim cell As Range
	Dim Asunto As String
	Dim Correo As String
	Dim Destinatario As String
	Dim Clave As String
	Dim Msg As String

	Set OutlookApp = New Outlook.Application
	'Recorremos la columna EMAIL
	For Each cell In Range("B11:B40")
		'Asignamos valor a las variables
		Asunto = "Contraseña"
		Destinatario = cell.Offset(0, -1).Value
		Correo = cell.Value
		Clave= Format(cell.Offset(0, 1).Value, "###0")
		Fecha = Format(cell.Offset(0, 2).Value, "dd/mmm/yyyy")
		'Cuerpo del mensaje
		Msg = "Buenos días" & Destinatario & vbNewLine & vbNewLine
		Msg = Msg & "Su nueva contraseña es..... "
		Msg = Msg & Clave & vbNewLine & vbNewLine
		Msg = Msg & "Nota:" & vbNewLine
		Msg = Msg & "Las claves se generan de forma aleatoria."
		Set MItem = OutlookApp.CreateItem(olMailItem)
		With MItem
			.To = Correo
			.Subject = Asunto
			.Body = Msg
			.Send
		End With
	Next
End Sub

Código: Seleccionar todo

Option Explicit
' >>>>>> ¡ATENCIÓN! NO HAY CONTROL DE ERRORES <<<<<<<<
Const NUEVA_LINEA As Integer = 13

Sub EnviarCorreoOutlook()
	Dim DocCalc As Object
	Dim HojaActiva As Object
	Dim oOLEService As Object
	Dim oOutlookApp As Object
	Dim oOutlookMail As Object
	Dim Fila As Long
	Dim Asunto As String
	Dim Correo As String
	Dim Destinatario As String
	Dim Clave As String
	Dim Msg As String

	DocCalc = ThisComponent
	HojaActiva = DocCalc.getCurrentController().getActiveSheet()
	oOLEService = createUnoService("com.sun.star.bridge.OleObjectFactory")
	oOutlookApp = oOLEService.createInstance("Outlook.Application")
	'Las FILAS comienzan por 0 (cero)
	For Fila = 10 To 39
		Asunto = "Contraseña"
		With HojaActiva
			Destinatario = .getCellRangeByName("A" & CStr(Fila)).getString()
			Correo = .getCellRangeByName("B" & CStr(Fila)).getString()
			Clave = Format(.getCellRangeByName("C" & CStr(Fila)).getValue(), "###0")
			Fecha = Format(.getCellRangeByName("D" & CStr(Fila)).getValue(), "dd/mmm/yyyy")
		End With
		'Cuerpo del mensaje
		Msg = "Buenos días" & Destinatario & Chr(NUEVA_LINEA)) & Chr(NUEVA_LINEA))
		Msg = Msg & "Su nueva contraseña es..... "
		Msg = Msg & Clave & Chr(NUEVA_LINEA)) & Chr(NUEVA_LINEA))
		Msg = Msg & "Nota:" & Chr(NUEVA_LINEA))
		Msg = Msg & "Las claves se generan de forma aleatoria."
		oOutlookMail = oOutlookApp.CreateItem(0)
		With oOutlookMail
			.To = Correo
			.Subject = Asunto
			.Body = Msg
			'Se puede adjuntar un archivo
			'.Attachments.Add("C:\ARCHIVO_ADJUNTO.TXT")
			'Se envía
			.Send()
		End With
	Next Fila
End Sub

Código: Seleccionar todo

Sub CreerMail_SystemShellExecute()  
  Dim oShell As Object 
  
  oShell = createUnoService("com.sun.star.system.SystemShellExecute")  
  
  '%0D%0A te permite dar un salto de linea en el cuerpo del mensaje. 
  oShell.Execute("mailto:xxx@xxxxx.com" & _ 
    "?subject=prueba" & _ 
    "&Body=" & _ 
    "%0D%0A" & Environ("") , "", 0) 
End Sub

Código: Seleccionar todo

Sub Iterar()
'
' Valor de Cuota para interes deudor
' Macro1 Macro
' Iteracion
'

ActiveWorkbook.Unprotect "DCGN"

'limite es el saldo de capital de la cuota posterior a la ingresada

Limite = Cells(6, 10).Value
Delta = Cells(10, 5).Value

'1ro
    If Limite > 1000000 Then

        While Limite > 1000000
            Delta = Delta + 10000
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    ElseIf Limite < -1000000 Then
        While Limite < -1000000
            Delta = Delta - 10000
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    Else
        Delta = Delta
    End If
'2do
    If Limite > 10000 Then

        While Limite > 1000
            Delta = Delta + 100
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    ElseIf Limite < -10000 Then
        While Limite < -1000
            Delta = Delta - 100
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    Else
        Delta = Delta
    End If
'3ro
    If Limite > 1000 Then

        While Limite > 1000
            Delta = Delta + 1
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    ElseIf Limite < -1000 Then
        While Limite < -1000
            Delta = Delta - 1
            Cells(10, 5).Value = Delta
            Limite = Cells(6, 10).Value
        Wend
    Else
        Delta = Delta
    End If


    Cells(10, 5).Value = Delta

MsgBox ("Simulación Terminada - Calculo del valor de la cuota")

ActiveWorkbook.Protect "DCGN"

'
End Sub

Código: Seleccionar todo

REM ***** BASIC *****
Option Explicit
'En BASIC prefiero declarar las variables explícitamente para prevenir errores

Sub Iterar()
'
' Valor de Cuota para interes deudor
' Macro para LibreOffice Calc
' Iteracion
'
	'Declaración de variables
	Dim HojaActiva As Object
	'Si estas variables no son de Tipo MONEDA modificar por la que corresponda (DOUBLE, LONG, ...)
	Dim Limite As Currency
	Dim Delta As Currency
	
	'Accedemos a la hoja activa
	HojaActiva = ThisComponent.getCurrentController().getActiveSheet()
	'En LibreOffice Calc Basic las variables objeto deben referenciarse siempre
	With HojaActiva
		'ActiveWorkbook.Unprotect "DCGN"
		.unProtect("DCGN")
	
		'limite es el saldo de capital de la cuota posterior a la ingresada
		'Limite = Cells(6, 10).Value
		'En LibreOffice Calc Basic el acceso a celdas por su posición es (columna, fila) y, además,
		'comienzan en 0 (cero), no en 1
		Limite = .getCellByPosition(9, 5).getValue()
		'Delta = Cells(10, 5).Value
		Delta = .getCellByPosition(4, 9).getValue()
	
'1ro	
		If Limite > 1000000 Then
			'Aunque existe "While...Wend" es preferible usar "Do While...Loop"
			Do While Limite > 1000000
				Delta = Delta + 10000
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		ElseIf Limite < -1000000 Then
			Do While Limite < -1000000
				Delta = Delta - 10000
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		Else
			Delta = Delta
		End If
'2do	
		If Limite > 10000 Then
	
			Do While Limite > 1000
				Delta = Delta + 100
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		ElseIf Limite < -10000 Then
			Do While Limite < -1000
				Delta = Delta - 100
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		Else
			Delta = Delta
		End If
'3ro	
		If Limite > 1000 Then
	
			Do While Limite > 1000
				Delta = Delta + 1
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		ElseIf Limite < -1000 Then
			Do While Limite < -1000
				Delta = Delta - 1
				'Cells(10, 5).Value = Delta
				.getCellByPosition(4, 9).setValue(Delta)
				'Limite = Cells(6, 10).Value
				Limite = .getCellByPosition(9, 5).getValue()
			Loop
		Else
			Delta = Delta
		End If
	
		'Cells(10, 5).Value = Delta
		.getCellByPosition(4, 9).setValue(Delta)
	
		'MsgBox (Simulación Terminada - Calculo del valor de la cuota)
		MsgBox "Simulación Terminada - Calculo del valor de la cuota", MB_OK + MB_ICONINFORMATION, "¡Atención!"
	
		'ActiveWorkbook.Protect "DCGN"
		.Protect("DCGN")
	End With
'
End Sub