faq

Conocer la Semana de una fecha dada

Ahí va una función que hace eso, calcular la semana de una fecha dada.

Function CalculaSemana(ByVal Fecha As Date) As Integer
    Dim FechaPrimAnyo As Date
    Dim DiaSemanaPrimAnyo As Integer
    Dim DiaSemanaFecha As Integer
    Dim Sumando As Integer
    Dim DiasTranscurridos As Integer

    FechaPrimAnyo = CDate("01/01/" & CStr(Year(Fecha)))
    DiaSemanaPrimAnyo = WeekDay(FechaPrimAnyo)
    DiaSemanaFecha = WeekDay(Fecha)
    DiasTranscurridos = Fecha - FechaPrimAnyo + DiaSemanaPrimAnyo - 1
    CalculaSemana = (DiasTranscurridos  7) + 1
End Function

Publicado en es.comp.lenguajes.visual-basic por Gabriel Ortí i Flores

– – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –

Un código mucho más corto, publicado por Enrique Medina en microsoft.public.es.vb el 28/08/2003

Function CalculaSemana(ByVal Fecha As Date) As Integer
    CalculaSemana = DatePart("ww", Fecha)
End Function

Relación Entidades Financieras (Actualizada al 24 de Junio de 2002)

Aquí tenéis la relación de Entidades Financieras en España, esta lista es útil para indicar la Entidad cuando se introduce un Número de Cuenta Bancaria.

El separador para importar a Access, es el Tabulador o CHR$(9).

8234    "A.I.G. FINANZAS S.A. E.F.C. "
1461    "A/S JYSKE BANK S.E. "
1255    "AAREAL BANK A.G. "
1244    "ABBEY NATIONAL PLC "
156    "ABN AMRO BANK N.V., S.E. "
8814    "ACCORDFIN ESPAÑA, E.F.C., S.A. "
4726    "ACCORDIA ESPAÑA, S.A. E.F.C. "
230    "ACTIVOBANK, S.A. "
4809    "ADEFISA LEASING, E.F.C., S.A. "
4446    "AFES TECNICAS DE TASACION, S.A. "
9832    "AFIANZAMIENTOS DE GALICIA, S.G.R. (AFIGAL) "
8233    "AHORROGESTION HIPOTECARIO S.A. (E.F.C.) E.F.C. "
1703    "AIRPORT CHANGE, S.A. "
4406    "ALIA TASACIONES, S.A. "
11    "ALLFUNDS BANK, S.A. "
1257    "ALLGEMEINE HYPOTHEKENBANK RHEINBODEN AG "
1209    "ALLIED BANKING CORPORATION "
99    "ALTAE BANCO, S.A. "
1170    "AMERICAN EXPRESS BANK, LTD. "
8810    "AMERICAN EXPRESS E.F.C., S.A. "
1710    "AMERICAN EXPRESS FOREIGN EXCHANGE, S.A. "
1709    "ANROGA, S.A. "
214    "ARAB BANK, PLC, S.E. "
9840    "ARAGONESA DE AVALES, S.G.R. (ARAVAL) "
8807    "ARALAR E.F.C., S.A. "
4416    "ARCO VALORACIONES, S.A. "
4788    "AROLEASING, E.F.C., S.A. "
4404    "ARQUITASA, S.T. COLEGIOS ARQUITECTOS ESPAÑA, S.A. "
4440    "ARQUITECTURA Y TASACIONES, S.A. "
1728    "ASSARF CHAABI, S.A. "
1462    "ASSOCIATES CAPITAL CORPORATION, PLC. S.E. "
8916    "ATLANTICO SERVICIOS FINANCIEROS, E.F.C., S.A. "
1705    "ATOCHA CAMBIOS, S.A. "
9818    "AVAL-MADRID, S.G.R. "
4419    "BALSUAR, S.A. "
8789    "BANASTURIAS LEASING E.F.C., S.A. "
1199    "BANCA CARIGE SPA-CASSA RISPARMIO GENOVA E IMPERIA "
163    "BANCA DI ROMA, S.P.A., S.E. "
174    "BANCA INTESA BANCA COMMERCIALE ITALIANA SPA S.E. "
61    "BANCA MARCH, S.A. "
1453    "BANCA MONTE DEI PASCHI DI SIENA, S.P.A., S.E. "
107    "BANCA NAZIONALE DEL LAVORO, S.P.A., S.E. "
78    "BANCA PUEYO, S.A. "
4819    "BANCANTABRIA INVERSIONES, S.A., E.F.C. "
188    "BANCO ALCALA, S.A. "
83    "BANCO ALICANTINO DE COMERCIO, S.A. "
136    "BANCO ARABE ESPAÑOL, S.A. "
8    "BANCO ATLANTICO, S.A. "
182    "BANCO BILBAO VIZCAYA ARGENTARIA, S.A. "
190    "BANCO BPI, S.A., S.E. "
86    "BANCO BSN BANIF, S.A. "
1231    "BANCO CANARIAS DE VENEZUELA, CA "
228    "BANCO CDC URQUIJO, S.A. "
21    "BANCO CONDAL, S.A. "
198    "BANCO COOPERATIVO ESPAÑOL, S.A. "
91    "BANCO DE ALBACETE, S.A. "
4    "BANCO DE ANDALUCIA, S.A. "
118    "BANCO DE ASTURIAS, S.A. "
82    "BANCO DE CASTILLA, S.A. "
24    "BANCO DE CREDITO BALEAR, S.A. "
1004    "BANCO DE CREDITO LOCAL DE ESPAÑA, S.A. "
3    "BANCO DE DEPOSITOS, S.A. "
133    "BANCO DE EUROPA, S.A. "
89    "BANCO DE EXTREMADURA, S.A. "
186    "BANCO DE FINANZAS E INVERSIONES, S.A. "
97    "BANCO DE GALICIA, S.A. "
123    "BANCO DE HUELVA, S.A., EN LIQUIDACION "
1123    "BANCO DE LA NACION ARGENTINA "
169    "BANCO DE LA NACION ARGENTINA, S.E. "
142    "BANCO DE LA PEQUEÑA Y MEDIANA EMPRESA, S.A. "
1234    "BANCO DE LA PROVINCIA DE BUENOS AIRES "
1196    "BANCO DE LAS ACTIVIDADES ECONOMICAS EXTERIORES "
59    "BANCO DE MADRID, S.A. "
69    "BANCO DE MURCIA, S.A. "
132    "BANCO DE PROMOCION DE NEGOCIOS, S.A. (PROMOBANC) "
81    "BANCO DE SABADELL, S.A. "
93    "BANCO DE VALENCIA, S.A. "
95    "BANCO DE VASCONIA, S.A. "
100    "BANCO DE VITORIA, S.A. "
109    "BANCO DEL DESARROLLO ECONOMICO ESPAÑOL, S.A. "
57    "BANCO DEPOSITARIO BBVA, S.A. "
155    "BANCO DO BRASIL, S.A., S.E. "
220    "BANCO ESFINGE, S.A. "
30    "BANCO ESPAÑOL DE CREDITO, S.A. "
131    "BANCO ESPIRITO SANTO, S.A. "
31    "BANCO ETCHEVERRIA, S.A. "
184    "BANCO EUROPEO DE FINANZAS, S.A. "
225    "BANCO FIMESTIC, S.A. "
46    "BANCO GALLEGO, S.A. "
42    "BANCO GUIPUZCOANO, S.A. "
217    "BANCO HALIFAX HISPANIA, S.A. "
43    "BANCO HERRERO, S.A. "
113    "BANCO INDUSTRIAL DE BILBAO, S.A. "
1238    "BANCO INTERNACIONAL, S.A. "
79    "BANCO INVERSION, S.A. "
232    "BANCO INVERSIS NET, S.A. "
115    "BANCO LIBERTA, S.A. "
130    "BANCO LUSO ESPAÑOL, S.A. "
1481    "BANCO MAIS, S.A. (ESPANHA), S.E. "
63    "BANCO MAPFRE, S.A. "
1168    "BANCO NACIONAL DE CUBA "
121    "BANCO OCCIDENTAL, S.A. "
72    "BANCO PASTOR, S.A. "
75    "BANCO POPULAR ESPAÑOL, S.A. "
216    "BANCO POPULAR HIPOTECARIO, S.A. "
1470    "BANCO PORTUGUES DE INVESTIMENTO, S.A. S.E. "
49    "BANCO SANTANDER CENTRAL HISPANO, S.A. "
1241    "BANCO SBS-AGRO "
48    "BANCO SIMEON, S.A. "
1469    "BANCO SYGMA HISPANIA, S.E. "
112    "BANCO URQUIJO, S.A. "
103    "BANCO ZARAGOZANO, S.A. "
125    "BANCOFAR, S.A. "
229    "BANCOPOPULAR-E, S.A. "
94    "BANCOVAL, S.A. "
38    "BANESTO BANCO DE EMISIONES, S.A. "
8910    "BANESTO FACTORING, S.A., E.F.C. "
1252    "BANK J. VONTOBEL & CO. AG. "
1103    "BANK OF AMERICA NA "
88    "BANK OF AMERICA, S.A. "
1483    "BANK OF SCOTLAND, S.E. "
1250    "BANK VON ERNST & CIE AG "
161    "BANKERS TRUST COMPANY, S.E. "
128    "BANKINTER, S.A. "
138    "BANKOA, S.A. "
168    "BANQUE BRUXELLES LAMBERT, S.E. "
1137    "BANQUE CENTRALE POPULAIRE "
1233    "BANQUE COMMERCIALE DU MAROC "
1475    "BANQUE CORTAL, S.E. "
1173    "BANQUE COURTOIS "
1197    "BANQUE INTERNATIONALE A LUXEMBOURG "
219    "BANQUE MAROCAINE COMMERCE EXTERIEUR INTERNAT.,S.A. "
1473    "BANQUE PRIVEE EDMOND DE ROTHSCHILD LUXEMBOURG, S.E "
1463    "BANQUE PSA FINANCE, S.E. "
1210    "BANQUE REGIONALE D##!##ESCOMPTE ET DE DEPOTS "
1116    "BANQUE SCANDINAVE EN SUISSE "
1113    "BANQUE SUDAMERIS "
1258    "BANQUE SYZ & CO, S.A. "
8909    "BANSABADELL FACTORING E.F.C., S.A. "
8211    "BANSABADELL HIPOTECARIA, E.F.C., S.A. "
4719    "BANSABADELL LEASING, E.F.C., S.A. "
8314    "BANSANDER DE FINANCIACIONES, S.A. E.F.C. "
8905    "BANZANO GROUP FACTORING, S.A., E.F.C. "
152    "BARCLAYS BANK PLC, S.E. "
65    "BARCLAYS BANK, S.A. "
4470    "BARNA-TASA, S.A. "
1182    "BAYERISCHE HYPO- UND VEREINSBANK AG. "
129    "BBVA BANCO DE FINANCIACION, S.A. "
8908    "BBVA FACTORING, E.F.C., S.A. "
35    "BBVA PRIVANZA BANCO, S.A. "
1245    "BES INVESTIMENTO SA "
2095    "BILBAO BIZKAIA KUTXA,AURREZKI KUTXA ETA BAHITETXEA "
8235    "BILBAO HIPOTECARIA, S.A., E.F.C. "
8780    "BMW FINANCIAL SERVICES IBERICA, E.F.C., S.A. "
58    "BNP PARIBAS ESPAÑA, S.A. "
8914    "BNP PARIBAS LEASE GROUP, S.A., E.F.C. "
144    "BNP PARIBAS SECURITIES SERVICES, S.E. "
149    "BNP PARIBAS, S.E. "
8791    "BNP-CONSUMO, E.F.C. S.A. "
1743    "BPI EXPRESS REMITTANCE SPAIN, S.A. "
2017    "C.A.M.P. CIRCULO CATOLICO DE OBREROS DE BURGOS "
1456    "C.R. DE CREDIT AGR. MUTUEL PYRENEES-GASCOGNE, S.E. "
1451    "CAISSE REGIONALE CREDIT AGRICOLE MUTUEL SUD MED,SE "
2080    "CAIXA DE AFORROS DE VIGO, OURENSE E PONTEVEDRA "
3025    "CAIXA DE C. DELS ENGINYERS-C.C. INGENIEROS, S.C.C "
3171    "CAIXA DELS ADVOCATS-CAJA DE LOS ABOGADOS, S.C.C. "
2040    "CAIXA D##!##ESTALVIS COMARCAL DE MANLLEU "
2013    "CAIXA D##!##ESTALVIS DE CATALUNYA "
2030    "CAIXA D##!##ESTALVIS DE GIRONA "
2041    "CAIXA D##!##ESTALVIS DE MANRESA "
2059    "CAIXA D##!##ESTALVIS DE SABADELL "
2073    "CAIXA D##!##ESTALVIS DE TARRAGONA "
2074    "CAIXA D##!##ESTALVIS DE TERRASSA "
2081    "CAIXA D##!##ESTALVIS DEL PENEDES "
2042    "CAIXA D##!##ESTALVIS LAIETANA "
3159    "CAIXA POPULAR-CAIXA RURAL, S.C.C.V. "
3045    "CAIXA R. ALTEA, C.C.V. "
3162    "CAIXA R. BENICARLO, S.C.C.V. "
3117    "CAIXA R. D##!##ALGEMESI, S.C.V.C. "
3147    "CAIXA R. DE BALEARS, S.C.C. "
3105    "CAIXA R. DE CALLOSA D##!##EN SARRIA, C.C.V. "
3096    "CAIXA R. DE L##!##ALCUDIA, S.C.V.C. "
3123    "CAIXA R. DE TURIS, C.C.V. "
3070    "CAIXA R. GALEGA, S.C.C.L.G. "
3111    "CAIXA R. LA VALL ""S. ISIDRO"", S.C.C.V. "
3174    "CAIXA R. VINAROS, S.C.C.V. "
4767    "CAIXALEASING Y FACTORING, E.F.C., S.A. "
2077    "CAJA AH. VALENCIA, CASTELLON Y ALICANTE, BANCAJA "
3172    "CAJA CAMINOS, S.C.C. "
2071    "CAJA DE AH. PROV. SAN FERNANDO DE SEVILLA Y JEREZ "
2032    "CAJA DE AHORRO PROVINCIAL DE GUADALAJARA "
2048    "CAJA DE AHORROS DE ASTURIAS "
2105    "CAJA DE AHORROS DE CASTILLA-LA MANCHA "
2091    "CAJA DE AHORROS DE GALICIA "
2086    "CAJA DE AHORROS DE LA INMACULADA DE ARAGON "
2037    "CAJA DE AHORROS DE LA RIOJA "
2043    "CAJA DE AHORROS DE MURCIA "
2104    "CAJA DE AHORROS DE SALAMANCA Y SORIA "
2066    "CAJA DE AHORROS DE SANTANDER Y CANTABRIA "
2097    "CAJA DE AHORROS DE VITORIA Y ALAVA "
2090    "CAJA DE AHORROS DEL MEDITERRANEO "
2018    "CAJA DE AHORROS MUNICIPAL DE BURGOS "
2094    "CAJA DE AHORROS Y M.P. DE AVILA "
2024    "CAJA DE AHORROS Y M.P. DE CORDOBA "
2099    "CAJA DE AHORROS Y M.P. DE EXTREMADURA "
2101    "CAJA DE AHORROS Y M.P. DE GIPUZKOA Y SAN SEBASTIAN "
2051    "CAJA DE AHORROS Y M.P. DE LAS BALEARES "
2038    "CAJA DE AHORROS Y M.P. DE MADRID "
2054    "CAJA DE AHORROS Y M.P. DE NAVARRA "
2045    "CAJA DE AHORROS Y M.P. DE ONTINYENT "
2069    "CAJA DE AHORROS Y M.P. DE SEGOVIA "
2085    "CAJA DE AHORROS Y M.P. DE ZARAGOZA, ARAGON Y RIOJA "
2100    "CAJA DE AHORROS Y PENSIONES DE BARCELONA "
3183    "CAJA DE ARQUITECTOS S.C.C. "
3184    "CAJA DE CREDITO DE ALCOY, C.C.V. (EN LIQUIDACION) "
3029    "CAJA DE CREDITO DE PETREL, CAJA RURAL, C.C.V. "
3181    "CAJA DE ELCHE, CAJA RURAL, C.C.V. "
3146    "CAJA ESCOLAR DE FOMENTO, S.C.C. "
2096    "CAJA ESPAÑA DE INVERSIONES, CAJA DE AHORROS Y M.P. "
2065    "CAJA GENERAL DE AHORROS DE CANARIAS "
2031    "CAJA GENERAL DE AHORROS DE GRANADA "
2052    "CAJA INSULAR DE AHORROS DE CANARIAS "
3035    "CAJA LABORAL POPULAR C.C. "
2092    "CAJA PROVINCIAL DE AHORROS DE JAEN "
3115    "CAJA R. ""NUESTRA MADRE DEL SOL"", S.C.A.C. "
3189    "CAJA R. ARAGONESA Y DE LOS PIRINEOS, S.C.C. "
3114    "CAJA R. CASTELLON S. ISIDRO, S.C.C.V. "
3110    "CAJA R. CATOLICO AGRARIA, S.C.C.V. "
3005    "CAJA R. CENTRAL, S.C.C. "
3116    "CAJA R. COMARCAL DE MOTA DEL CUERVO, S.C.L.C.A. "
3056    "CAJA R. DE ALBACETE, S.C.C. "
3150    "CAJA R. DE ALBAL, C.C.V. "
3179    "CAJA R. DE ALGINET, S.C.C.V. "
3001    "CAJA R. DE ALMENDRALEJO, S.C.C. "
3021    "CAJA R. DE ARAGON, S.C.C. "
3059    "CAJA R. DE ASTURIAS, S.C.C. "
3138    "CAJA R. DE BETXI, S.C.C.V. "
3060    "CAJA R. DE BURGOS, C.C. "
3177    "CAJA R. DE CANARIAS, S.C.C. "
3127    "CAJA R. DE CASAS IBAÑEZ, S.C. - C.C.A., "
3137    "CAJA R. DE CASINOS S.C.C.V. "
3062    "CAJA R. DE CIUDAD REAL, S.C.C. "
3063    "CAJA R. DE CORDOBA, S.C.C. "
3064    "CAJA R. DE CUENCA, S.C.C. "
3009    "CAJA R. DE EXTREMADURA, S.C.C. "
3022    "CAJA R. DE FUENTEPELAYO, S.C.C. "
3007    "CAJA R. DE GIJON, C.C "
3023    "CAJA R. DE GRANADA, S.C.C. "
3140    "CAJA R. DE GUISSONA, S.C.C. "
3067    "CAJA R. DE JAEN, S.C.C. "
3154    "CAJA R. DE LA CARLOTA, S.C.A.C.L. (EN LIQUIDACION) "
3128    "CAJA R. DE LA RODA S.C.C. "
3008    "CAJA R. DE NAVARRA, S.C.C. "
3016    "CAJA R. DE SALAMANCA, S.C.C. "
3078    "CAJA R. DE SEGOVIA, C.C. "
3017    "CAJA R. DE SORIA, S.C.C. "
3076    "CAJA R. DE TENERIFE, S.C.C. "
3080    "CAJA R. DE TERUEL, S.C.C. "
3081    "CAJA R. DE TOLEDO, S.C.C. "
3118    "CAJA R. DE TORRENT, C.C.V. "
3020    "CAJA R. DE UTRERA, S.C.A.L.C. "
3144    "CAJA R. DE VILLAMALEA, S.C.C.A. "
3152    "CAJA R. DE VILLAR C.C.V. "
3085    "CAJA R. DE ZAMORA, C.C. "
3093    "CAJA R. DEL CAMPO DE CARIÑENA, S.C.C.L. "
3083    "CAJA R. DEL DUERO, S.C.C.L. "
3187    "CAJA R. DEL SUR, S. COOP. DE CREDITO "
3058    "CAJA R. INTERMEDITERRANEA, S.C.C. "
3157    "CAJA R. LA JUNQUERA DE CHILCHES, S.C.C.V. "
3089    "CAJA R. NTRA. SRA. DE GUADALUPE, S.C.C.A. "
3104    "CAJA R. NTRA. SRA. DEL CAMPO, S.C.A.C. "
3098    "CAJA R. NTRA. SRA. DEL ROSARIO, S.C.A.C. "
3134    "CAJA R. NTRA. SRA. LA ESPERANZA DE ONDA, S.C.C.V. "
3018    "CAJA R. S. AGUSTIN DE FUENTE-ALAMO .- S.C.C., "
3161    "CAJA R. S. FORTUNATO, S.C.C.C.L. "
3166    "CAJA R. S. ISIDRO DE LES COVES VINROMA, S.C.C.V. "
3165    "CAJA R. S. ISIDRO DE VILAFAMES, S.C.C.V. "
3119    "CAJA R. S. JAIME ALQUERIAS NIÑO PERDIDO S.C.C.V. "
3113    "CAJA R. S. JOSE DE ALCORA S.C.C.V. "
3130    "CAJA R. S. JOSE DE ALMASSORA, S.C.C.V. "
3112    "CAJA R. S. JOSE DE BURRIANA, S.C.C.V. "
3135    "CAJA R. S. JOSE DE NULES S.C.C.V. "
3160    "CAJA R. S. JOSE DE VILLAVIEJA S.C.C.V. "
3095    "CAJA R. S. ROQUE DE ALMENARA S.C.C.V. "
3102    "CAJA R. S. VICENTE FERRER DE VALL DE UXO, S.C.C.V. "
3094    "CAJA R. VALENCIA CASTELLANA, S.C.C. REQUENA (V.) "
3084    "CAJA R. VASCA, S.C.C. "
3186    "CAJA R.,SANTOS PIEDRA ALBALAT DELS SORELLS, C.C.V. "
3121    "CAJA RURAL DE CHESTE, S.C.C. "
3082    "CAJA RURAL DEL MEDITERRANEO, RURALCAJA, S.COOP. CR "
1729    "CAMBIOS SOL, S.A. "
1735    "CAMBIOS Y TRANSFERENCIAS ALFA Y OMEGA, S.A. "
1708    "CAMBITUR INTERNATIONAL, S.A. "
1751    "CAPITAL MONEY TRANSFER, S.A. "
1198    "CASSE DI RISPARMIO DI FIRENZE E PISTOIA E PESCIA "
4706    "CATERPILLAR FINANCIAL CORPORACION FINANCIERA, S.A. "
9811    "CENTRO AVALES IND. EDICION, S.G.R., EN LIQUIDACION "
1714    "CHANGE AND TRANSFER, S.A. "
1723    "CHANGE CENTER, S.A. "
1717    "CHANGE EXPRESS CATALUNYA, S.A. "
1704    "CHANGE EXPRESS, S.A. "
1730    "CHANGEPOINT, S.A. "
122    "CITIBANK ESPAÑA, S.A. "
1474    "CITIBANK INTERNATIONAL PLC, S.E. "
3169    "COBANEXPO, S.C.C.L. "
8804    "COFIBER FINANCIERA, E.F.C., S.A. "
8796    "COFIDIS HISPANIA EFC, S.A. "
4462    "COL.LECTIU ARQUITECTES TAXADORS, S.A. "
2056    "COLONYA - CAIXA D##!##ESTALVIS DE POLLENSA "
8612    "COMERCIANTES REUNIDOS DEL SUR, S.A., E.F.C. "
159    "COMMERZBANK AKTIENGESELLSCHAFT, S.E. "
4486    "COMPAÑIA CASTELLANO LEONESA DE TASACIONES, S.A. "
4488    "COMPAÑIA DE MEDIOS Y SERVICIOS DE TASACION, S.A. "
9891    "COMPAÑIA ESPAÑOLA DE REAFIANZAMIENTO, S.A. "
4368    "COMPAÑIA HISPANIA DE TASACIONES Y VALORACIONES, SA "
2000    "CONFEDERACION ESPAÑOLA DE CAJAS DE AHORROS "
4322    "CONSULTTASA, S.A. "
4386    "CONTINENTAL DE TASACIONES, S.A. "
1459    "COOP.CENTR. RAIFFEISEN-BOERENL.(RABOBANK NED.)S.E. "
8221    "CORPORACION HIPOTECARIA MUTUAL, S.A., E.F.C. "
9821    "CREDIAVAL, S.G.R. "
4782    "CREDIDUERO, S.A., E.F.C. "
1225    "CREDIT AGRICOLE INDOSUEZ LUXEMBOURG, S.A. "
154    "CREDIT AGRICOLE INDOSUEZ, S.E. "
1177    "CREDIT INDUSTRIEL ET COMMERCIAL "
105    "CREDIT LYONNAIS, S.A. S.E. "
1460    "CREDIT SUISSE, S.E. "
3188    "CREDIT VALENCIA, C.R.C.C.V. "
8240    "CREDITER S.A., E.F.C. "
1457    "DE LAGE LANDEN INTERNATIONAL B.V., S.E. "
1183    "DEN DANSKE BANK INTERNATIONAL, S.A. "
1254    "DEPFA BANK EUROPE PLC "
145    "DEUTSCHE BANK A.G., S.E. "
205    "DEUTSCHE BANK CREDIT, S.A. "
19    "DEUTSCHE BANK, S.A.E. "
1467    "DEUTSCHE HYP DEUTSCHE H.FRANKFURT-HAMBURG A.G., SE "
1206    "DEXIA NORDIC PRIVATE BANK LUXEMBOURG, S.A. "
231    "DEXIA SABADELL BANCO LOCAL, S.A. "
1731    "DILO EXPRESS, S.A. "
1739    "DOLLAR EXPRESS, S.A. "
1261    "DRESDNER BANK (SCHWEIZ) AG "
143    "DRESDNER BANK A.G., S.E. "
1239    "DZ BANK AG DEUTSCHE ZENTRAL-GEN., FRANKFURT A.M. "
4753    "EDAMLEASING E.F.C., S.A. "
1733    "EL IMPERIO DEL ENVIO IMPERENVIOS, S.A. "
8911    "ELECTROLUX FINANCIERA, S.A., E.F.C. "
9806    "ELKARGI, S.G.R. "
4402    "ENTIDAD DE TASACIONES, S.A. "
1737    "ENVIA TELECOMUNICACIONES, S.A. "
1750    "ENVIALIA MONEY TRANSFERS, S.A. "
1222    "EQUITABLE P.C.I. BANK "
1164    "ESPIRITO SANTO BANK OF FLORIDA "
8798    "EURO CREDITO E.F.C., S.A. "
191    "EUROBANK DEL MEDITERRANEO, S.A. "
1702    "EURODIVISAS, S.A. "
1468    "EUROHYPO A.G. EUROPAISCHE HYPOTHEKENBANK D.B.,S.E. "
4467    "EUROPEA GENERAL DE VALORACIONES, S.A. "
4385    "EUROTASA, S.A. "
4388    "EUROVALORACIONES, S.A. "
4380    "EXPERTISE, S.A. "
1748    "EXPRESS PADALA ESPAÑA, S.A. "
8915    "FACTORCAT, E.F.C., S.A. "
218    "FCE BANK PLC S.E. "
9845    "FIANZAS Y SERVICIOS FINANCIEROS, S.G.R. "
1721    "FILIPINO EXPRESS, S.A. "
1454    "FIMAT INTERNATIONAL BANQUE, S.E. "
8788    "FINANCIACAIXA 2, E.F.C., S.A. "
8308    "FINANCIERA CARRION, S.A., E.F.C. "
8805    "FINANCIERA EL CORTE INGLES E.F.C., S.A. "
8567    "FINANCIERA OVIEDO S.A. E.F.C. "
8815    "FINANDIA E.F.C., S.A. "
8793    "FINANMADRID, S.A., E.F.C. "
8321    "FINANZIA TRUCKS, E.F.C., S.A. "
9    "FINANZIA, BANCO DE CREDITO, S.A. "
8776    "FINCONSUM, E.F.C., S.A. "
1713    "FOREIGN EXCHANGE COMPANY DE ESPAÑA, S.A. "
1200    "FORTIS BANK, S.A. "
167    "FORTIS BANK, S.A., S.E. "
1466    "FRANFINANCE, S.E. "
4367    "GABINETE DE TASACIONES INMOBILIARIAS, S.A. "
4379    "GECOPINSA TASACIONES, S.A. "
4363    "GENERAL DE VALORACIONES, S.A. "
223    "GENERAL ELECTRIC CAPITAL BANK, S.A. "
1738    "GESTION DE TRANSFERENCIAS, S.A. "
4455    "GESTION DE VALORACIONES Y TASACIONES, S.A. "
1745    "GIROEXPRESS, S.A. "
8714    "GMAC ESPAÑA S.A. DE FINANCIACION, E.F.C. "
8811    "GRUPO DE SERVICIOS HIPOTECARIOS ON-LINE, EFC, SA "
4448    "GRUPO TASVALOR, S.A. "
4423    "GURRUCHAGA TASACIONES, S.A. "
4789    "H. SANTOS, E.F.C., S.A. "
224    "HBF BANCO FINANCIERO, S.A. "
8903    "HELLER FACTORING ESPAÑOLA, S.A. E.F.C. "
8206    "HIPOTEBANSA E.F.C., S.A. "
8209    "HIPOTECAIXA, E.F.C., S.A. "
8236    "HISPAMER SERVICIOS FINANCIEROS, E.F.C., S.A. "
4485    "HISPANO EUROPEA DE TASACIONES, S.A. "
1747    "HISPANO WORLD TRANSFER, S.A. "
162    "HSBC BANK PLC, S.E. "
1458    "HSBC INVESTMENT BANK PLC. S.E. "
4334    "I.V. INTERVALOR, S.A. "
233    "IBERAGENTES POPULAR BANCA PRIVADA, S.A. "
9846    "IBERAVAL, S.G.R. "
4832    "IBERCAJA LEASING Y FINANCIACION, S.A., E.F.C. "
4422    "IBERTASA, S.A. "
4761    "IBM FINANCIACION E.F.C., S.A. "
1232    "ING BANK N.V. "
1465    "ING BANK N.V., S.E. "
4709    "ING LEASE (ESPAÑA), E.F.C., S.A. "
4359    "INMOSEGUROS TASACION, S.A. "
1000    "INSTITUTO DE CREDITO OFICIAL "
4403    "INTA, S.A., S.T. "
1741    "INTERENVIOS MONEY TRANSFERS, S.A "
8912    "INTER-FACTOR EUROPA, S.A. E.F.C., E.F.C. "
4328    "INTERNACIONAL DE TRANSACCIONES Y SERVICIOS, S.A. "
4327    "INTERTECNICA DE VALORACIONES Y PATRIMONIOS, S.A. "
9801    "ISBA, S.G.R. "
222    "J.P. MORGAN BANK, S.A. "
1711    "JET PERU MONEY TRANSFER, S.A. "
1482    "JOHN DEERE BANK, S.A., S.E. "
151    "JPMORGAN CHASE BANK, S.E. "
1150    "KBC BANK "
4323    "KRATA, S.A. "
1155    "KREDIETBANK, S.A. LUXEMBOURGEOISE "
4415    "L & L, SOCIEDAD DE TASACION, S.A. "
1701    "LA PEDRESINA III, S.A. "
1242    "LANDESBANK BADEN-WÜRTTEMBERG "
1236    "LANDESBANK HESSEN-THUERINGEN GIROZENTRALE "
1725    "LATINOENVIOS, S.A. "
4779    "LEASING CATALUNYA, E.F.C., S.A. "
4713    "LICO LEASING, S.A., E.F.C. "
4444    "LKS TASACIONES, S.A. "
106    "LLOYDS TSB BANK PLC, S.E. "
1240    "LONDON FORFAITING A PARIS, S.A. "
8342    "LUZARO E.F.C. S.A. "
2098    "M.P. Y CAJA DE AHORROS DE HUELVA Y SEVILLA "
2010    "M.P. Y CAJA GENERAL AHORROS DE BADAJOZ "
2103    "M.P.C.A. RONDA, CADIZ, ALMERIA, MALAGA Y ANTEQUERA "
1716    "MACCORP EXACT CHANGE, S.A. "
4837    "MADRID LEASING CORPORACION, S.A., E.F.C. "
1736    "MASTER ENVIOS UNIDOS, S.A. "
4442    "MEDITERRANEA DE TASACIONES, S.A. "
4799    "MERCEDES-BENZ CREDIT E.F.C., S.A. "
1478    "MERRILL LYNCH INTERNATIONAL BANK LTD., S.E. "
8618    "MONETICIA, S.A. E.F.C. "
1734    "MONEY EXCHANGE, S.A. "
1724    "MONEY GRAM SPAIN, S.A. "
1749    "MONEYCARD POST EXPRESS, S.A. "
8524    "MONTJUICH EF E.F.C., S.A. "
8734    "MULTIAHORRO E.F.C., S.A. "
4372    "MURCIANA DE TASACIONES, S.A. "
1138    "NATEXIS BANQUES POPULAIRES "
1479    "NATEXIS BANQUES POPULAIRES, S.E. "
1464    "NEWCOURT FINANCE (FRANCE) S.N.C., S.E. "
1260    "NORDEA BANK, S.A. "
4487    "NORMA VALORACIONES, S.A. "
1249    "NORWICH AND PETERBOROUGH BUILDING SOCIETY "
1727    "OFICINA DE REMESAS Y SERVICIOS AFINES, S.A. "
4447    "OFICINA DE TASACIONES, S.A. "
9843    "OINARRI, S. DE G. PARA LA ECONOMIA SOCIAL, S.G.R. "
8620    "PASTOR SERVICIOS FINANCIEROS, E.F.C., S.A. "
73    "PATAGON INTERNET BANK, S.A. "
1221    "PHILIPPINE NATIONAL BANK, S.A. "
1193    "PKB PRIVATBANK AG. "
8219    "PRAGA DE HIPOTECAS Y CREDITOS E.F.C., S.A. "
1246    "PRIMER B. AH. Y PREST. VIV. FAM., S.A. (VIVIBANCO) "
200    "PRIVAT BANK, S.A. "
1251    "PRIVATBANK IHAG ZURICH "
1719    "QUICK CHANGE, S.A. "
1732    "QUISQUEYANA IBERIA, S.A. "
1706    "R.D. MONEY TRANSFER, S.A. "
4420    "REGULATION WORLD, S.A. "
8345    "RENAULT FINANCIACIONES, S.A. E.F.C. "
1224    "RHEINHYP RHEINISCHE HYPOTHEKENBANK A.G. "
4456    "RISC VALOR, S.A. "
1746    "ROMERO TRANSFER AND COURIER, S.A. "
1149    "ROYAL BANK OF CANADA "
1471    "ROYAL BANK OF CANADA EUROPE LIMITED, S.E. "
1715    "S.A. DE VIAJES Y SERVICIOS DE AUTOPISTA (SAVISA) "
8906    "S.C.H. FACTORING Y CONFIRMING, S.A., E.F.C. "
1229    "S.E.B. PRIVATE BANK, S.A. "
9839    "S.G.R. DE ANDALUCIA(SURAVAL) "
9829    "S.G.R. DE ASTURIAS (ASTURGAR) "
9813    "S.G.R. DE LA COMUNIDAD VALENCIANA "
9816    "S.G.R. DE SANTANDER (SOGARCA) "
9819    "S.G.R. PYME PONTEVEDRA Y ORENSE (SOGARPO) "
4838    "SA NOSTRA DE INVERSIONES, E.F.C., S.A. "
185    "SABADELL BANCA PRIVADA, S.A. "
1718    "SAFE MONEY TRANSFER SPAIN, S.A. "
8490    "SANTANA CREDIT, E.F.C., S.A. "
36    "SANTANDER CENTRAL HISPANO INVESTMENT, S.A. "
4757    "SANTANDER CENTRAL HISPANO LEASE, E.F.C. "
4797    "SANTANDER CENTRAL HISPANO MULTILEASING,S.A. E.F.C. "
8813    "SCANIA FINANCE HISPANIA E.F.C., S.A. "
8816    "SDAD. CONJUNTA EMISION GESTION MEDIOS PAGO, EFC,SA "
4333    "SERIN, SERVICIOS INMOBILIARIOS, S.A. "
8795    "SERVICIOS FINANCIEROS CARREFOUR, E.F.C., S.A. "
8797    "SERVICIOS FINANCIEROS CONTINENTE, E.F.C., S.A. "
4307    "SERVICIOS VASCOS DE TASACIONES, S.A. "
9842    "SOCIEDAD DE AVALES DE CANARIAS SOGAPYME, S.G.R. "
9844    "SOCIEDAD DE GARANTIA RECIPROCA EXTREMEÑA DE AVALES "
9826    "SOCIEDAD DE GARANTIAS DE CANARIAS, S.G.R.(SOGARTE) "
4301    "SOCIEDAD DE TASACION, S.A. "
211    "SOCIEDAD ESPAÑOLA DE BANCA DE NEGOCIOS PROBANCA,SA "
4474    "SOCIEDAD INTEGRAL DE VALORACIONES AUTOMATIZADAS,SA "
9808    "SOCIEDAD NAVARRA DE GARANTIA RECIPROCA (SONAGAR) "
108    "SOCIETE GENERALE, S.E. "
8225    "SOLBANK LEASING E.F.C., S.A. "
1127    "STANDARD CHARTERED BANK "
8812    "SÜDLEASING ESPAÑA E.F.C., S.A. "
1247    "SUMITOMO MITSUI BANKING CORPORATION "
1742    "SUN MONEY EXPRESS, S.A. "
1191    "SVENSKA HANDELSBANKEN "
8640    "TARCREDIT, E.F.C., S.A. "
4383    "TASABALEAR, S.A. "
4468    "TASACIONES - 7, S.A. "
4358    "TASACIONES ANDALUZAS, S.A. "
4320    "TASACIONES DE BIENES MEDITERRANEO, S.A. "
4459    "TASACIONES HIPOTECARIAS RENTA, S.A. "
4302    "TASACIONES HIPOTECARIAS, S.A. "
4313    "TASACIONES INMOBILIARIAS, S.A. (TINSA) "
4305    "TASACIONES MADRID, S.A. "
4408    "TASACIONES ORFE, S.A. "
4400    "TASACIONES Y CONSULTORIA, S.A. "
4381    "TASACIONES Y SERVICIOS INMOBILIARIOS, S.A. "
4317    "TASACIONES Y VALORACIONES DE GALICIA, S.A. "
4304    "TASIBERICA, S.A. "
4434    "TECGLEN TASACIONES, S.A. "
4315    "TECNICOS EN TASACION, S.A. (TECNITASA) "
8918    "TELEFONICA FACTORING, E.F.C., S.A. "
1740    "TELEGIROS, S.A. "
1156    "THE BANK OF NEW YORK "
160    "THE BANK OF TOKYO-MITSUBISHI LTD., S.E. "
189    "THE INDUSTRIAL BANK OF JAPAN, LTD. S.E. "
1477    "THE ROYAL BANK OF SCOTLAND PLC, S.E. "
9828    "TRANSAVAL, S.A., S.G.R. "
4784    "TRANSOLVER FINANCE, E.F.C., S.A. "
226    "UBS ESPAÑA, S.A. "
1472    "UCABAIL, S.E. "
1744    "UNIGIROS EXPRESS, S.A. "
9836    "UNION ANDALUZA DE AVALES, S.G.R. (AVALUNION) "
8596    "UNION CTO. FINAN. MOB. E INMOB. CREDIFIMO "
8512    "UNION DE CREDITOS INMOBILIARIOS, S.A., E.F.C. "
9827    "UNION DE EMPRESARIOS MURCIANOS, S.G.R. (UNDEMUR) "
8769    "UNION FINANCIERA ASTURIANA, S.A., E.F.C. "
1720    "UNITED EUROPHIL, S.A. "
1726    "UNIVERSAL DE ENVIOS, S.A. "
4445    "UNIVERSAL DE TASACION, S.A. "
1707    "UNO MONEY TRANSFERS, S.A. "
227    "UNOE BANK, S.A. "
4336    "VALORACIO D##!## ACTIUS, S.A. "
4472    "VALORACIONES FRASER, S.A. "
4350    "VALORACIONES MEDITERRANEO, S.A. "
4387    "VALORACIONES PATRIMONIALES, S.A. "
4478    "VALORACIONES Y PERITACIONES GTS T. LEVANTE, S.A. "
4392    "VALORACIONES Y TASACIONES HIPOTECARIAS, S.A. "
4432    "VALTASAR SOCIEDAD DE TASACIONES, S.A. "
4337    "VALTEC, S.A. "
4311    "VALTECNIC, S.A. "
4393    "VATPE, S.A. "
8806    "VFS FINANCIAL SERVICES SPAIN E.F.C., S.A. "
1480    "VOLKSWAGEN BANK GMBH, S.E. "
8307    "VOLKSWAGEN FINANCE S.A., E.F.C. "
1202    "WACHOVIA BANK, NATIONAL ASSOCIATION "
1248    "WAFABANK "
1259    "WESTDEUTSCHE INMOBILIENBANK "
196    "WESTDEUTSCHE LANDESBANK GIROZENTRALE, S.E. "
1722    "WORLD CURRENCY, S.A. "
1256    "WÜRTTEMBERGISCHE HYPOTHEKENBANK AG "
8778    "XEROX DE FINANCIACION, S.A., E.F.C. "
4349    "ZEHAZKI, S.A. "

Convertir datos entre diferentes formatos

Se trata de una función, a la que le enviamos cualquier tipo de dato y nos lo devuelve convertido al que queramos, según el indicador que reciba.

Public Function ValidarCampo(Campo As Variant, I As Integer) As Variant
    'SI VIENE VACÍO O CON NULO
    If Campo = "" Or IsNull(Campo) Then
        ValidarCampo = ""
    Else
        Select Case I   'PARA DEVOLVER EL TIPO DE CONVERSION
            Case 1 'CONVERSIÓN A INTEGER
                ValidarCampo = CInt(Campo)
            Case 2 'CONVERSIÓN A LONG
                ValidarCampo = CLng(Campo)
            Case 3 'CONVERSIÓN A DOUBLE
                ValidarCampo = CDbl(Campo)
            Case 4 'CONVERSIÓN A SINGLE
                ValidarCampo = CSng(Campo)
            Case 5 'CONVERSIÓN A FECHA
                ValidarCampo = CDate(Campo)
            Case 6 'CONVERSIÓN A CADENA
                ValidarCampo = CStr(Campo)
        End Select
    End If
End Function

Conocer el número de Años entre dos fechas

Este código calcula el número de años entre dos fechas. Muy válido para calcular la edad de una persona teniendo en cuenta la fecha actual. Usa la función DateSerial de creación de fechas.

Public Function AñosEntre(ByVal Fecha1 As Date, ByVal Fecha2 As Date) As Integer
    Dim Años As Integer
    Años = DateDiff("yyyy", Fecha1, Fecha2)
    If Fecha1 < DateSerial(Year(Fecha1), Month(Fecha2), Day(Fecha2)) Then
        Años = Años - 1
    End If
    AñosEntre = Años
End Function

Fuente Código de Barras Code39

Este código es de longitud variable, cuya limitación en el largo la da el espacio disponible para imprimir y la capacidad del lector de código de barra que usaremos.

El juego de caracteres del código 39 incluye 43 caracteres: los dígitos 0-9, las letras A-Z (mayúscula solamente), el espacio y los siguientes símbolos: – + . $ / *. El * es el carácter de inicio y final del código, por lo que no deberá usarse en un texto a codificar.

Cada carácter se compone de 5 barras y 4 espacios. 3 de estos 9 elementos son anchos (de allí el nombre ‘3 de 9’) y 6 angostos.

Importante: El carácter de control es el asterisco debe iniciar el número a leer con un asterisco y finalizar con el mismo, por ejemplo el número de credencial 3115 se imprimiría así: *3115*

Fuente TTF: http://descarga.e-mision.net/code39_1.zip

Es la misma fuente que la anterior pero no pone los caracteres ‘humanos’ debajo.

http://descarga.e-mision.net/code39_2.zip 

Si necesitas incluir espacios en blanco, usa el carácter ‘~’. Algunas fuentes también definen el carácter ‘_’.

Vamos a sincronizar nuestro PC con un reloj atómico en Internet, esto nos servirá para mantener el PC actualizado, sobre todo en el caso de los Servidores.

Con este ejemplo vamos a ver como nos conectamos a un servidor externo, por un puerto indicado, recogeremos la hora actual GMT y actualizaremos las hora de nuestro ordenador. Utilizaremos el protocolo TCP del control Microsoft WinSock Control (MsWinSck.Ocx).

Vamos a conectarnos con el servidor www.boulder.nist.gov. Usando el puerto 13.

Este servicio trabaja de la siguiente manera (nosotros seremos el cliente):

  • Servidor: Esta escuchando en el puerto 13.
  • Cliente: Conectamos con el puerto 13
  • S: Nos envía la hora
  • C: Recibimos la cadena de la hora actual
  • C: Cerramos la conexión
  • S: Cierra la conexión

El servidor esta escuchando en el puerto 13 a al espera de las posibles conexiones que puedan realizarse. Cuando se establece una conexión, el servidor reenvía el valor horario y cierra la conexión. Si el servidor no esta disponible la conexión será rechazada o cerrada sin enviar nada.

Código del Programa

En principio no supone mayor problema si conocemos un poco el funcionamiento de los Socket. Vamos a por el código para ver lo simple que resulta:

Para este proyecto hay que añadir el componente «Microsoft Winsock Control 5.0» y vamos a llamarle «Socket».

Option Explicit
Private Sub Form_Load()
    ' Si no esta cerrado lo cerramos, pura precaución
    If Socket.State  sckClosed Then Socket.Close
    ' Configuramos el puerto
    Socket.Protocol = sckTCPProtocol
    Socket.RemoteHost = "www.boulder.nist.gov"
    Socket.RemotePort = 13
    ' Conectamos
    Socket.Connect
End Sub
Private Sub Socket_Close()
    ' Si se cierra el socket
    If Socket.State  0 Then Socket.Close
End Sub
Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
    Dim DatosRecibidos As String
    
    DatosRecibidos = String(bytesTotal, " ")
    Socket.GetData DatosRecibidos, vbString, bytesTotal
    MsgBox "Hora Actual: " & DatosRecibidos
End Sub

Como veis el proceso es muy sencillo, es conectar y esperar la respuesta.

Ahora vamos a formatear los datos recibidos para presentarlo adecuadamente y prepararlo para asignar la hora al sistema.

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
    Dim DatosRecibidos As String    ' Contenedor de los datos recibidos
    Dim FechaActual As Date         ' Para convertir la fecha
    Dim Resultado As Long           ' Respuesta del API
    Dim HoraSistema As SYSTEMTIME   ' Asignación para el API
    Dim TxtTmp As String            ' Variable de apoyo para los procesos
    
    DatosRecibidos = String(bytesTotal, " ")
    Socket.GetData DatosRecibidos, vbString, bytesTotal
    
    Debug.Print DatosRecibidos
    ' Vamos a eliminar los caracteres que no nos sirven CHR(10) por "" (caracteres nulos)
    ' Estan al principio y final
    If Left(DatosRecibidos, 1) = Chr(10) Then DatosRecibidos = Mid(DatosRecibidos, 2)
    If Right(DatosRecibidos, 1) = Chr(10) Then DatosRecibidos = Left(DatosRecibidos, Len(DatosRecibidos) - 1)
    
    ' Extraemos la fecha con formato yy-mm-dd y la hora hh:nn:ss
    TxtTmp = Mid(DatosRecibidos, InStr(DatosRecibidos, Chr(32)) + 1, 17)
    ' Convertimos a fecha con formato dd/mm/yy
    FechaActual = CDate(Mid$(TxtTmp, 7, 2) & "/" & Mid$(TxtTmp, 4, 2) & "/" & Mid$(TxtTmp, 1, 2) & " " & Mid$(TxtTmp, 10))
    
    ' Ahora preparamos los datos para actualizar el reloj del sistema
    With HoraSistema
        .wYear = DatePart("yyyy", FechaActual)
        .wMonth = DatePart("m", FechaActual)
        .wDay = DatePart("d", FechaActual)
        .wHour = DatePart("h", FechaActual)
        .wMinute = DatePart("n", FechaActual)
        .wSecond = DatePart("s", FechaActual)
        .wMilliseconds = 0
    End With
    ' Asignamos la hora al sistema
    Resultado = SetSystemTime(HoraSistema)
    MsgBox FechaActual & vbCrLf & DatosRecibidos & " GMT"
End Sub

La función SetSystemTime actualiza la hora teniendo en cuenta la diferencia horaria con respecto a la hora GMT o UTC.

Y ya tenemos el programa terminado, bueno faltan las declaraciones de la API y del Tipo de Datos SYSTEMTIME:

Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Conocer si es año bisiesto.

Prueba esta función, si devuelve True es que es Bisiesto.

Function BisiestoSINO(Year As Date) As Boolean
    Dim Mod400 As Long, Mod100 As Long, Mod4 As Long
    
    BisiestoSINO = False 'Indica si es bisiesto o no
    Mod400 = Year Mod 400
    Mod100 = Year Mod 100
    Mod4 = Year Mod 4
    
    If (Mod400 = 0) Then BisiestoSINO = True
    If (Mod100 = 0) And (Mod400  0) Then BisiestoSINO = False
    If (Mod4 = 0) And (Mod100  0) Or ((Mod4 = 0) And (Mod400 = 0)) Then BisiestoSINO = True
End Function

Publicado en microsoft.public.es.asp por Pablo Viojo

Function BisiestoSINO(Year As Date) As Boolean
    BisiestoSINO = Day(DateSerial(Year(Fecha), 3, 0)) = 29
End Function

Tagen nos ha enviado otra función más cortita.

Conocer el último día del mes.

Sólo tienes que sumar un mes al día 1 del mes actual y restarle un día.

Function UltimoDiaMes(Fecha As Date) As Date 
    UltimoDiaMes = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(Fecha), Month(Fecha), 1))) 
End Function

Tagen nos ha enviado otras 2 funciones para obtener el mismo resultado.

Están basadas en que para la función DateSerial el día 0 de un mes es el ultimo día del mes anterior.

Function UltimoDiaMes(Fecha As Date) As Date 
    UltimoDiaMes = DateSerial(Year(Fecha), Month(Fecha) + 1, 0) 
End Function 

Function UltimoDiaMes2(Fecha As Date) As Byte 
    UltimoDiaMes2 = Day(DateSerial(Year(Fecha), Month(Fecha) + 1, 0)) 
End Function

Publicado en microsoft.public.es.vb por Rubén Vigón