¿Retomando el blog?

Llevo años si poner nada aquí y seguramente seguiré así. Sin embargo aquí colgaré las cosas que pueden ser útiles para la comunidad o solo por contar ciertos proyectos que voy haciendo.

En unos minutos pondré una publicación.

Código que utilizo para tabular los esquemas.

Sub Tabular()
    Dim Tabs As Integer
    Tabs = 0
    QuitarIntrosDobles
    Selection.HomeKey Unit:=wdStory
    For i = 1 To 400
   
        Selection.MoveDown Unit:=wdParagraph, Count:=1
        If Selection.Text = "" Then
            Selection.Delete
        Else
            If Selection.Style = "Indices1" Then
                Tabs = 1
                Selection.Style = "Normal"
            Else
                If Selection.Style = "Indices2" Then
                    PonerTabs (1)
                    Tabs = 2
                    Selection.Style = "Normal"
                Else
                    If Selection.Style = "Indices3" Then
                        PonerTabs (2)
                        Tabs = 3
                        Selection.Style = "Normal"
                    Else 'Es normal
                        PonerTabs (Tabs)
                    End If
                End If
            End If
        End If
    Next
End Sub

Sub PonerTabs(cantidad As Integer)
    Selection.HomeKey Unit:=wdLine
    For j = 1 To cantidad
        Selection.TypeText Text:=vbTab
    Next j
End Sub

Sub QuitarIntrosDobles()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

WPUT: Enviar ficheros a un servidor FTP por línea de comandos

WPUT: Enviar ficheros a un servidor FTP por línea de comandos.

http://wput.sourceforge.net/

SendEmail: E-mail por línea de comandos

E-mail por línea de comandos.

Útil para incorporarlo en programas o para tareas administrativas.

http://caspian.dotconf.net/menu/Software/SendEmail/

Eliminar instalaciones "fantasma" de Windows XP

Si aparecen al arrancar varias instalaciones de WindowsXP y solo debería haber una.

• Botón derecho en Mi PC-->Propiedades
• Opciones avanzadas-->Inicio y recuperación-->Configuración
• Editar
• Se borran las líneas que sobran y se guarda

Letra aleatoria en Excel

=CARACTER(ALEATORIO.ENTRE(65;90))

Colorear código para ponerlo en la web

Esta dirección es de gran utilidad y trae muchos lenguajes:

http://www.scourdesign.com/articulos/tutoriales/colorear/index.php

Desordenar una columna de valores en Excel

Sub Desordenar()
    Dim rango As Range
 
    Set rango = Selection.Cells
       
    For i = 1 To rango.Rows.Count
        Dim aleatorio As Integer
        Dim cadena As String
        rango.Rows(i).Select
        cadena = ActiveCell.FormulaR1C1
        
       
        aleatorio = Int(Rnd() * rango.Rows.Count) + 1
        rango.Rows(i).FormulaR1C1 = rango.Rows_
(aleatorio).FormulaR1C1
        rango.Cells(aleatorio).FormulaR1C1 = cadena
    Next
End Sub 

Ejecutar varios programas al mismo tiempo en VBS

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "Ruta1" & Chr(34), 0
WshShell.Run chr(34) & "Ruta2" & Chr(34), 0
WshShell.Run chr(34) & "Ruta3" & Chr(34), 0

Crear muchas carpetas en vbs

'Crea las carpetas desde Equipo1 a Equipo100
'El archivo se guarda con extensión vbs y adelante.
Dim fso, fldr, i
Set fso = CreateObject("Scripting.FileSystemObject")
for i=1 to 100
    Set fldr = fso.CreateFolder("Equipo" & i)
next

VBA Excel: Brain Training


Sub InventarOperaciones()
    Dim i As Integer
    Dim NumOperaciones As Integer
    Dim operacion As String
    NumOperaciones = 10
    For i = 1 To NumOperaciones
        Cells(i, 1) = Int((Rnd * 10) + 1)
        operacion = Int((Rnd * 3) + 1)
        If operacion = "1" Then operacion = "+"
        If operacion = "2" Then operacion = "-"
        If operacion = "3" Then operacion = "*"
        Cells(i, 2) = operacion
        Cells(i, 3) = Int((Rnd * 10) + 1)
        Cells(i, 4) = ""
        Cells(i, 5) = ""
    Next
    Cells(1, 4).Select
End Sub

Sub ComprobarOperaciones()
    Dim i As Integer
    Dim NumOperaciones As Integer
    Dim operacion As String
    Dim resultado As Integer
    Dim puntos As Integer
    NumOperaciones = 10
    puntos = 0
    For i = 1 To NumOperaciones
        operacion = Cells(i, 2)
        If operacion = "+" Then resultado = Cells(i, 1) + Cells(i, 3)
        If operacion = "-" Then resultado = Cells(i, 1) - Cells(i, 3)
        If operacion = "*" Then resultado = Cells(i, 1) * Cells(i, 3)
        If Cells(i, 4) = resultado Then
            Cells(i, 5) = "OK"
            puntos = puntos + 1
        Else
            Cells(i, 5) = resultado
        End If
        
    Next
    MsgBox "PUNTOS:" & puntos
End Sub


Access VBA: Realizar una consulta por código


Private Sub tipo_AfterUpdate()
    Dim r As DAO.Recordset
    Dim db As DAO.Database
    Dim SQL As String
    Set db = CurrentDb
    SQL = "select * from servicios where codservicio=" & tipo
    Set r = db.OpenRecordset(SQL)
    descripcion = r(1)
    precio = r(2)
End Sub


Excel VBA: Crear tablas de multiplicar


Sub Prueba()
    For i = 1 To 10
        For j = 1 To 10
            Range(Cells(i, j), Cells(i, j)).Select
            ActiveCell.FormulaR1C1 = i & "x" & j & "=" & i * j
        Next
    Next
End Sub



Access: Consulta de eliminación con más de una tabla

Si se intentan borrar registros como "productos de la familia pescados", si hay dos tablas involucradas sale el siguiente mensaje:

"Especifique la tabla que contiene los registros que desea eliminar."

Para hacer esto se debe poner en la consulta el asterisco (*) de la tabla que contiene los registros a eliminar y los campos imprescindibles del resto de la consulta

JavaScript: Acceder al valor de un RadioButton

Esta función devuelve el valor seleccionado en un grupo de botones de opción (RadioButton).


function getRadioButtonSelectedValue(ctrl)

{

    for(i=0;i<ctrl.length;i++)

        if(ctrl[i].checked) return ctrl[i].value;

}




Se la debe llamar como valor=getRadioButtonSelectedValue(document.formulario.nombreradio);

Calcular la edad de una persona

En Excel

Siendo A2 el lugar donde está la fecha de nacimiento.

=AÑO(HOY())-AÑO(A2)-1 + (MES(HOY())>MES(A2)) + (MES(A2)=MES(HOY()))*(DIA(HOY())>=DIA(A2))

En Access

En un módulo se pone este código.

Function Edad (FechaNacimiento As Variant) As Integer
       Dim miEdad As Variant
      If IsNull(FechaNacimiento) then Edad = 0: Exit Function
      miEdad = DateDiff("yyyy", FechaNacimiento, Now)
      If Date < DateSerial(Year(Now), Month(FechaNacimiento)_
, Day(FechaNacimiento)) Then
         miEdad = miEdad - 1
      End If
      Edad = CInt(miEdad)
    End Function

Ya se puede usar en las consultas.

Error en PHP: Cannot modify header information

Si sale este mensaje en PHP

Warning: Cannot modify header information - headers already sent by (output started at /var/www/vhost/home/html/tienda/includes/languages/espanol/modules/payment/banktransfer.php:26) in /var/www/vhost/home/html/tienda/includes/functions/general.php on line 33

Significa que se ha enviado una respuesta antes de terminar con las cabeceras. Este error suele solucionarse mirando los dos ficheros que comenta (seguramente el primero) y borrar los espacios que pudiera haber antes de la marca <?php y despues de ?>

Quitar la barra amarilla de Internet Explorer para páginas locales

Para los desarrolladores que quieren probar constantemente su web localmente con IE sin que salga la barra de seguridad del internet explorer y service pack 2

Hay que agregar esta linea al HTML antes del body:

<!-- saved from url=(0013)about:internet -->


Validar con DreamWeaver en castellano

El script que genera el Dreamweaver para validar formularios está en inglés.

Como es un código JavaScript se puede sustituir por el que aparece aquí. En vista código, se busca un apartado que pondrá SCRIPT y sustituye el existente por este otro.


<script language="JavaScript" type="text/JavaScript">

<!--

function MM_findObj(n, d) { //v4.01

var p,i,x; if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) {

d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}

if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n];

for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document);

if(!x && d.getElementById) x=d.getElementById(n); return x;

}



function MM_validateForm() { //v4.0

var i,p,q,nm,test,num,min,max,errors='',args=MM_validateForm.arguments;

for (i=0; i<(args.length-2); i+=3) { test=args[i+2]; val=MM_findObj(args[i]);

if (val) { nm=val.name; if ((val=val.value)!="") {

if (test.indexOf('isEmail')!=-1) { p=val.indexOf('@');

if (p<1 || p==(val.length-1)) errors+='- '+nm+' debe contener una dirección de correo válida.\n';

} else if (test!='R') { num = parseFloat(val);

if (isNaN(val)) errors+='- '+nm+' debe ser un número.\n';

if (test.indexOf('inRange') != -1) { p=test.indexOf(':');

min=test.substring(8,p); max=test.substring(p+1);

if (num<min || max<num) errors+='- '+nm+' debe ser entre '+min+' y '+max+'.\n';

} } } else if (test.charAt(0) == 'R') errors += '- '+nm+' es un dato obligatorio.\n'; }

} if (errors) alert('Error(es) en el formulario:\n'+errors);

document.MM_returnValue = (errors == '');

}

//-->

</script>



Para que sirva de orientación, el código que hay que sustituir es el siguiente:


<script type="text/JavaScript">

<!--

function MM_findObj(n, d) { //v4.01

var p,i,x; if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) {

d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}

if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n];

for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document);

if(!x && d.getElementById) x=d.getElementById(n); return x;

}



function MM_validateForm() { //v4.0

var i,p,q,nm,test,num,min,max,errors='',args=MM_validateForm.arguments;

for (i=0; i<(args.length-2); i+=3) { test=args[i+2]; val=MM_findObj(args[i]);

if (val) { nm=val.name; if ((val=val.value)!="") {

if (test.indexOf('isEmail')!=-1) { p=val.indexOf('@');

if (p<1 || p==(val.length-1)) errors+='- '+nm+' must contain an e-mail address.\n';

} else if (test!='R') { num = parseFloat(val);

if (isNaN(val)) errors+='- '+nm+' must contain a number.\n';

if (test.indexOf('inRange') != -1) { p=test.indexOf(':');

min=test.substring(8,p); max=test.substring(p+1);

if (num<min || max<num) errors+='- '+nm+' must contain a number between '+min+' and '+max+'.\n';

} } } else if (test.charAt(0) == 'R') errors += '- '+nm+' is required.\n'; }

} if (errors) alert('The following error(s) occurred:\n'+errors);

document.MM_returnValue = (errors == '');

}

//-->

</script>


El Word me la juega (Reemplazar la selección).

Durante un rato el Word ha hecho una cosa rara. Cuando yo selecciono un texto y escribo se supone que debería borrar lo seleccionado. El Word dejó de hacerlo y tenía que hacerlo "a mano".

¿Cómo se arregla?

Herramientas-->Opciones-->Edición-->Reemplazar la selección al escribir (debe aparecer marcada)