miércoles, 25 de septiembre de 2013

CREAR INDICE DE HOJAS CON EL DATO QUE HAY EN LA CELDA C4 (DE CADA HOJA)


Sub Listado_Hojas()



'19-abr-11
Dim dato As Long
Dim rangoA1 As Range
Dim NuevoNombre, Resp
'Se validan archivos abiertos.
'
On Error GoTo Errores
Application.StatusBar = "Creando índice ..."
Application.ScreenUpdating = False
ActiveWorkbook.Sheets.Add Before:=Sheets(1)
Set rangoA1 = Sheets(1).Range("a1")
Sheets(1).Range("a1").Value = "ÍNDICE"
dato = ActiveWorkbook.Sheets.Count
Application.Calculation = xlCalculationManual
For i = 1 To dato
    With Sheets(1)
        .Hyperlinks.Add Anchor:=rangoA1.Offset(i, 0), Address:="", _
        SubAddress:="'" & Sheets(i).Name & "'" & "!A1", _
        TextToDisplay:="+'" & Sheets(i).Name & "'" & "!C4"
       

    End With
Next i
ActiveSheet.Range("A2").EntireRow.Delete
Application.ScreenUpdating = True
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic


Cells.Select
    ActiveWindow.DisplayGridlines = False
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    Columns("B:B").ColumnWidth = 36.29
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With


Resp = MsgBox("Desea asignarle un nombre la hoja de índice creada?", vbYesNoCancel + vbQuestion, AddIn)
If Resp = vbYes Then
Application.Dialogs(xlDialogWorkbookName).Show
Else
Exit Sub
End If
Exit Sub
Errores:
Application.Calculation = xlCalculationAutomatic


MsgBox "Ha ocurrido un error: " & vbNewLine & vbNewLine & Err.Description, vbExclamation, AddIn

End Sub

martes, 24 de septiembre de 2013

COMO NOMBRAR HOJAS (Cuando el nombre esta en una Celda de la misma hoja)

Dim w As Worksheet
For Each w In ThisWorkbook.Worksheets w.Name = w.Range("B8")
Next w
End Sub

luego vas a cada una de tus hojas y colocas lo siguiente

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$8" Then
ActiveSheet.Name = Range("B8")
End If
End Sub

Fuente:http://www.todoexpertos.com/categorias/tecnologia-e-internet/software-y-aplicaciones/microsoft-excel/respuestas/1936210/nombre-de-hoja-segun-datos-de-una-celda

miércoles, 22 de mayo de 2013

COMO DESCARGAR UN ARCHIVO A UNA CARPETA DESDE UNA URL DEFINIDA

Option Explicit Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Dim Ret As Long Sub Sample() Dim strURL As String'almacena link Dim strPath As String'almacena direccion donde va a guardar strURL = "http://www.superfinanciera.gov.co/Cifras/informacion/diarios/tcrm/historia.xls" strPath = "D:\Mis documentos\Historico TRM\myfilename.xls"'importante al pegar la ruta debe poner el nombre del archivo como va quedar guardado junto con la extension Ret = URLDownloadToFile(0, strURL, strPath, 0, 0)'realizar descarga If Ret = 0 Then MsgBox "File successfully downloaded" Else MsgBox "Unable to download the file" End If End Sub