dimecres, 16 de febrer del 2011

La funció DIR en VB

'#########
Public Sub LectorNiveles()
CurrentDb.Execute "delete from Niveles"
a = 0
Fichero = Dir("C:\Barcelona\*.jnl")
Do While Fichero <> ""
a = a + 1
importa_text "C:\Barcelona\" & Fichero
Fichero = Dir
Loop
MsgBox "fets " & a & " Fitxers JNL"
End Sub
'#########

Aquest bonic codi fa servir la funció dir, però... com funciona. Res més simple que provar-ho dins la finestra INMEDIATO. S'enten de seguit:

?dir ("C:\Barcelona\*.jnl")
Alfa.jnl
?dir
Beta.jnl
?dir
Gamma.jnl

El primer ens situa en la carpeta que volem
Cada dir posterior avança una línia en el resultat, es a dir, com si fos la línia següent en l'antic DOS.

(que ningú s'espanti pel jnl; és un tipus especial de txt vinculat a MicroStation)

dissabte, 12 de febrer del 2011

Unificació d'Itàlia


Mapa de la unificació d'Itàlia. Font Wikipèdia

Obrir una carpeta amb Vba

Hem fet un botó anomenat
"cmdDescarregues"
que, al pulsar-lo, ens obre la carpeta
"C:\Program Files\JDOWNLOADER\"

Option Compare Database
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_NORMAL = 1

Private Sub cmdDescarregues_Click()
Call ShellExecute(Me.hwnd, "Open", "C:\Program Files\JDOWNLOADER\", &O0, &O0, SW_NORMAL)
End Sub

dijous, 10 de febrer del 2011

Crear una consulta d'unió en Access 2007

Partim d'aquestes dades:

El que volem és una consulta final que ens doni totes les dades, es a dir, 8 registres numèrics que poden tenir -o no- una lletra. El resultat esperat el que veiem en la darrera imatge.

Les taules no tenen res d'especial.

La Qry1 inclou "TODOS LOS REGISTROS DE ALFA Y SOLO AQUELLOS DE BETA DONDE LOS CAMPOS COMBINADOS SEAN IGUALES"

La Qry2 inclou "TODOS LOS REGISTROS DE BETA Y SOLO AQUELLOS DE ALFA DONDE LOS CAMPOS COMBINADOS SEAN IGUALES"

Es a dir, gràficament:


Finalment, la consulta d'unió (que sols es pot veure en SQL) es la següent:

SELECT [LETRA],[NUMERO]
FROM [QRY1]
UNION
SELECT [LETRA],[NUMERO]
FROM [QRY2];

Es a dir, sel·leccionem els camps de la consulta Qry1 i els unim als mateixos camps de la Qry2.

dissabte, 5 de febrer del 2011

Esborrar fitxers amb Vb. Moure fitxers amb Vb

En Vb tenim una funció molt útil per eliminar fitxers que es la funció Kill. Aquesta funció però, te un petit problema. Ho elimina del tot. No queda ni tan sols a la paperera de reciclatge.

Per evitar riscs, el que podem fer és moure els fitxers a una carpeta provisional o fins i tot a la paperera de reciclatge (això ho veurem en un altre post). La raó es que en el projecte en que estic treballant, hi ha bastants fitxers auxiliars de tipus bat o exe i no vull eliminar-los accidentalment.

La idea es borrar tots els fitxers xlsx dins de la carpeta C:\Madrid. En lloc d'eliminar-los definitivament els deixarem dins la carpeta c:\Madrid\Paperera

No faig servir el Filecopy perquè tot i que tothom indica que és molt fàcil, al final no funciona mai (o de moment no ho se fer servir)

El codi:
###############################################################
Private Sub cmdKiller_Click()
'Aquestes dues declaracions son per el msgbox
'la primera declaració es la pregunta que apareixerà
'la segona declaració recull el event del msgbox
Dim ComentariKiller, RespostaKiller As String

'La tercera i cuarta declaració serveixen per determinar la ubicació
'del directori d'origen i el de destí
Dim FicherosOrigen, FicherosDestino As String

'Finalment declarem un objecte per fer servir el FSO
Dim fs As Object

'Determinem els directoris amb els que volem treballar
'Es important afegir la contrabarra al final per facilitar el codi
FicherosOrigen = "C:\madrid\"
FicherosDestino = "C:\madrid\Paperera\"

'Escribim el comentari que presentarà el msgbox
ComentariKiller = "Vols esborrar TOTS els XLSX?"

'Preparem la resposta que rebrem al escollir una opció del msgbox
'El vbOkCancel presentarà dos botons ok i cancel
'El vbDefaultButton2 fa que el botó per defecte sigui el de cancel
'El "Chungo de la muerte" es el que apareixerà com a títol del msgbox
RespostaKiller = MsgBox(ComentariKiller, vbExclamation + vbOKCancel + vbDefaultButton2, "Chungo de la muerte")

'Ara fem un select case. Les respostes dels botons son vbok o vbcancel
Select Case RespostaKiller
Case vbOK
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile FicherosOrigen & "*.xlsx", FicherosDestino
Set fs = Nothing
'els borrem definitivament
Kill "c:\madrid\*.xlsx"
Case vbCancel
MsgBox "no borro res"
End Select

End Sub
###############################################################


La idea de fer servir el FSO l'he tret de:
http://forums.devarticles.com/microsoft-access-development-49/copy-file-using-vba-30811.html

dijous, 20 de gener del 2011

Informes en Access amb VBA

Es tracta de fer un informe que reflecteixi el resultat de dues consultes a partir d'un taula:


Pas 1) Creem les dues consultes:
Consulta que comptabilitza els cognoms: Simplement agrupem i fem servir la opció cuenta. El camp es diu, directament, CuentaDeApellido. La consulta es diu QryNumeroAlumnos

Consulta que comptabilitza els alumnes de Barcelona. S'ha modificat el nom del camp que ara es diu TotalBarcelona. La consulta es diu QryBarcelona

Pas 2) Creem l'informe. Les txtbox es diuen, respectivament, txtAlumnos y txtBarcelona
Finalment apliquem el codi que conté un recordset. Atenció: Report Activate

Per si no es veu bé:

Option Compare Database
Option Explicit
Dim rs As Recordset, dbs As Database

Private Sub Report_Activate()

'Es declara una variable pel recordset i una per la base de dades

'S'assigna a la variable base de dades la base activa
Set dbs = CurrentDb

'S'obre el recordset pel objecte database des
'del objecte (consulta) "QryNumeroAlumnos"
Set rs = dbs.OpenRecordset("QryNumeroAlumnos")

'Es situa en una posició del recordset
rs.MoveFirst
Me!txtAlumnos = rs![CuentadeApellido]

Set rs = dbs.OpenRecordset("QryBarcelona")

'rs.MoveFirst
Me!txtBarcelona = rs![TotalBarcelona]

End Sub

dimecres, 12 de gener del 2011

Modificar un text amb EDG de MicroStation

Si volem modificar, per exemple, un element de text 02299 a 022991 és tan simple com:

EdG> set search /char="02299"
EdG> MODIFY CHAR="022991" TOP TO END

Ja està. L'ajuda parla de modify character=substitute i no se quins rollos més. Però es tan fàcil com això.

Si ho volem fer per bastants fitxers, sols cal obrir un edg (amb un fitxer qualsevol) i des d'alli invocar a un txt amb un contingut similar a aquest:

edg c:\barcelona\Alfag.dgn
set search /char="002"
modify char="0021" top to end
edg c:\barcelona\Betag.dgn
set search /char="004"
modify char="0041" top to end
edg c:\barcelona\Betag.dgn
set search /char="006"
modify char="0061" top to end
edg c:\barcelona\Gammag.dgn
set search /char="007"
modify char="0071" top to end
edg c:\barcelona\Gammag.dgn
set search /char="00793"
modify char="007931" top to end
edg c:\barcelona\Deltag.dgn
set search /char="00798"
modify char="007981" top to end
exit


Si aquest fitxer, es digués, per exemple, "CanviarCodis.txt", i estigues ubicat a c:\temp, des del EDG obert ho invocariem amb l'arroba:

Edg> @c:\Temp\CanviarCodis.txt

Atenció que no cal possar cap cometa ni res semblant...

Precaució: Cal tenir present que canviarà TOTS els txt que coincideixin amb la cadena solicitada. Es a dir, no podem modificar sols el primer text que aparegui..

Tags:
EDG
MICROSTATION
MODIFY CHARACTERS
SUBSTITUTE
Cambiar una cadena de texto con edg
How to change a string with edg