Utente:Amarvudol/VBA comuni USA
Questo codice è disponibile sotto le licenze CC-by-sa 3.0 e GFDL 1.3 ove applicabile (poiché pubblicata su una pagina di Wikipedia) e GPL 2.0 (poiché è un software), tenendo conto comunque che VBA, ADO e la libreria di run-time necessaria sono copyright della Microsoft Corp.
Lo metto qui per future riutilizzazioni.
Option Explicit
Sub CreaVoci()
' ISTRUZIONI
' Non è un bot. E' solo un programmino che crea una serie di file *.txt pronti per essere copiati in altrettante voci di Wikipedia.
' Per utilizzare lo script è necessario creare un foglio Excel con i seguenti campi
' (titoli nella prima riga, dati in colonna):
' N --> numero progressivo
' Città --> nome della città o località
' Contea --> contea
' ConteaWiki --> Titolo della voce di it.wiki della contea
' Status --> City, Town, Village o CDP (per altri stati modificare lo script)
' Abitanti 2000 --> numero di abitanti USCB del 2000
' Abitanti 2009 --> numero di abtanti USCB del 2009 (per altri anni modificare lo0 script)
' Area --> superficie in miglia quadrate (sq mi)
' Superficie --> superficie in km quadrati (moltiplicare area per 2,589988110336)
' INTPTLAT --> latitudine decimale (senza virgola o segno)
' INTPTLNG --> longitudine decimale (senza virgola o segno)
' latG --> latitudine in gradi
' latM --> ecc.
' latS
' lonG
' lonM
' lonS
' GNIS ID --> ID del Geographic Names Information System (GNIS) (non senrve nello script, ma è utile per cercare i dati)
' Ele(ft) --> altitudine in piedi (ft)
' Altitudine --> altitudine in metri (moltiplicare Ele(ft) per 0,3048)
' CAP --> lo Zip Code americano
' NomeAbitanti --> ovvio
' Telefono --> prefisso telefonico, Area Code americano
' Sito --> url del sito ufficiale (se esiste)
'
' Nell'editor VBA creare un modulo associato al file intitolato CreaVoci (o simile).
' Modificare "a mano" alcuni dati nello script qui sotto: percorso (il percorso assoluto dove mettere i file creati), e le varie note da inserire.
' Per altri stati modificare Mississippi ovunque nello script con quello giusto.
' Lo script funziona solo se è installato ADODB: nell'editor VBA cliccare su "Strumenti" -> "Riferimenti"
' e verificare che ci sia il flag su "Microsoft ActiveX Data Objects 2.X" (dove 2.X dovrebbe essere uguale o maggiore di 2.8).
' Lo script funziona con Excel 2003 SP3. Altre versioni da verificare.
' Riempita la tabella, lanciare la macro dal menù di Excel.
On Error GoTo Gestore_Errori
Dim cnXLS As ADODB.Connection
Dim rsXLS As ADODB.Recordset
Dim i As Long
Dim latDec As String
Dim lonDec As String
Dim latDecG, latDecM, latDecS As Double
Dim lonDecG, lonDecM, lonDecS As Double
Dim Voce, Voce0, Voce1, Voce2, Voce3, Voce4, Voce5, Voce6 As String
Dim msg As VbMsgBoxResult
Dim anno, abitanti, status, status1, densità As String
Dim percorso As String
Dim notaabitanti2000, notaabitanti2009, notasuperficie, notaaltitudine, sitoweb As String
' Inizializza un po' di variabili
percorso = "<--INSERIRE UN PERCORSO ASSOLUTO-->" ' percorso di salvataggio dei file
notaabitanti2000 = "<ref name=USCB2000>{{cita web|url=http://www.census.gov/prod/cen2000/phc-1-26.pdf|titolo=Summary Population and Housing Characteristics|data=novembre 2009|opera=Mississippi: 2000|editore=U.S. Census Bureau|accesso=23-07-2010|lingua=en}}</ref>"
notaabitanti2009 = "<ref name=USCB2009>{{cita web|url=http://www.census.gov/popest/cities/tables/SUB-EST2009-04-28.xls|titolo=Table 4. Annual Estimates of the Resident Population for Incorporated Places in Mississippi: April 1, 2000 to July 1, 2009|opera=Incorporated Places and Minor Civil Divisions|editore=U.S. Census Bureau|accesso=23-07-2010|lingua=en}}</ref>"
notasuperficie = "<ref name=SUP>{{cita web|url=http://factfinder.census.gov/servlet/GCTTable?_bm=y&-context=gct&-ds_name=DEC_2000_SF1_U&-_box_head_nbr=GCT-PH1&-CONTEXT=gct&-mt_name=PEP_2008_EST_GCTT1R_ST9S&-tree_id=806&-redoLog=false&-geo_id=04000US28&-format=ST-7|titolo=Mississippi -- Place|opera=American Fact Finder|editore=U.S. Cernsus Bureau|accesso=23-07-2010|lingua=en}}</ref>"
' Apre la connessione ADO con il foglio Excel contenente i dati in tabella
Set cnXLS = New ADODB.Connection
With cnXLS
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=Excel 8.0"
.Open
End With
' Inidcare il numero di colonne/campi della tabella
ActiveWorkbook.Names.Add Name:="tblCittà", RefersToR1C1:="='" & ActiveWorkbook.ActiveSheet.Name & "'!C1:C30"
' Apre il recordset con i dati del foglio di Excel
Set rsXLS = New ADODB.Recordset
With rsXLS
.CursorType = adOpenForwardOnly
.LockType = adLockOptimistic
.ActiveConnection = cnXLS
.Source = "SELECT * FROM tblCittà WHERE (tblCittà.N Is Not Null)"
.Open
End With
While Not rsXLS.EOF
i = i + 1 'indice del record corrente
Debug.Print rsXLS.Fields("Città").Value
' Anno e numero di abitanti
If rsXLS.Fields("Abitanti 2009").Value <> "" Then
anno = 2009 & notaabitanti2009
abitanti = Format(rsXLS.Fields("Abitanti 2009").Value, "##,##0")
ElseIf rsXLS.Fields("Abitanti 2000").Value <> "" Then
anno = 2000 & notaabitanti2000
abitanti = Format(rsXLS.Fields("Abitanti 2000").Value, "##,##0")
End If
' Status della località per l'incipit
status1 = UCase(Left(rsXLS.Fields("Status").Value, 1)) & LCase(Right(rsXLS.Fields("Status").Value, Len(rsXLS.Fields("Status").Value) - 1))
Select Case rsXLS.Fields("Status").Value
Case "city"
status = "è una città (''city'')"
Case "town"
status = "è una città (''town'')"
Case "village"
status = "è una località (''village'')"
Case "CDP"
status = "è un centro abitato e un [[census-designated place]] (CDP)"
status1 = "[[census-designated place|CDP]]"
End Select
' Densità solo se esiste il numero di abitanti e la superficie
If (abitanti > 0) And (rsXLS.Fields("Superficie").Value > 0) Then
densità = Format(Round(abitanti / rsXLS.Fields("Superficie").Value, 0), "###,###")
End If
' Popola la nota sull'altitudine dal GNIS
If rsXLS.Fields("GNIS ID").Value <> "" Then
notaaltitudine = "<ref name=ALT>{{cita web|url=http://geonames.usgs.gov/pls/gnispublic/f?p=gnispq:3:::NO::P3_FID:" & rsXLS.Fields("GNIS ID").Value & "|titolo=" & rsXLS.Fields("Città").Value & "|opera=Geographic Names Information System (GNIS)|editore=U.S. Geological Survey|accesso=23-07-2010|lingua=en}}</ref>"
Else
notaaltitudine = "<ref name=ALT>{{cita web|url=http://geonames.usgs.gov/pls/gnispublic/f?p=gnispq:2:::NO::P1_CLASS,P1_STATE:Civil,Mississippi|titolo=Mississippi|opera=Geographic Names Information System (GNIS)|editore=U.S. Geological Survey|accesso=23-07-2010|lingua=en}}</ref>"
End If
' Calcola le coordinate decimali
latDecG = rsXLS.Fields("latG").Value
latDecM = rsXLS.Fields("latM").Value / 60
latDecS = rsXLS.Fields("latS").Value / 3600
lonDecG = rsXLS.Fields("lonG").Value
lonDecM = rsXLS.Fields("lonM").Value / 60
lonDecS = rsXLS.Fields("lonS").Value / 3600
latDec = CStr(Int(latDecG + latDecM + latDecS)) & "." & Mid(CStr((Round(latDecG + latDecM + latDecS, 8) - Int(latDecG + latDecM + latDecS))), 3, 8)
lonDec = CStr(Int(lonDecG + lonDecM + lonDecS)) & "." & Mid(CStr((Round(lonDecG + lonDecM + lonDecS, 8) - Int(lonDecG + lonDecM + lonDecS))), 3, 8)
' Se ha più di 10.000 abitanti mette il template Stub
If rsXLS.Fields("Abitanti 2009").Value > 10000 Then
Voce0 = "{{S|Mississippi}}" & Chr(10)
Else
Voce0 = ""
End If
' Spezza il testo per evitare troppi ritorni a capo
Voce1 = Voce0 & _
"{{ComuneUSA" & Chr(10) & _
"|nomeCitta = " & rsXLS.Fields("Città").Value & Chr(10) & _
"|nomeOriginale = " & rsXLS.Fields("Città").Value & ", Mississippi" & Chr(10) & _
"|status = " & status1 & Chr(10) & _
"|linkPanorama = " & Chr(10) & _
"|linkBandiera = " & Chr(10) & _
"|linkStemma = " & Chr(10) & _
"|linkMappa = " & rsXLS.Fields("Contea").Value & " County Mississippi Incorporated and Unincorporated areas " & rsXLS.Fields("Città").Value & " Highlighted.svg" & Chr(10) & _
"|pxMappa = 250px" & Chr(10) & _
"|stato = {{US Mississippi}}" & Chr(10) & _
"|contea = [[" & rsXLS.Fields("ConteaWiki").Value & "|" & rsXLS.Fields("Contea").Value & "]]" & Chr(10) & _
"|anno = " & anno & Chr(10) & _
"|abitanti = " & abitanti & Chr(10) & _
"|densità = " & densità & Chr(10) & _
"|zonaOraria = Central (CST)" & Chr(10) & _
"|fusoOrario = [[UTC-6]]" & Chr(10)
Voce2 = "|altitudine = " & rsXLS.Fields("Altitudine").Value & notaaltitudine & Chr(10) & _
"|superficie = " & rsXLS.Fields("Superficie").Value & notasuperficie & Chr(10) & _
"|latGradi = " & rsXLS.Fields("latG").Value & Chr(10) & _
"|latMinuti = " & rsXLS.Fields("latM").Value & Chr(10) & _
"|latSecondi = " & rsXLS.Fields("latS").Value & Chr(10) & _
"|latNS = N" & Chr(10) & _
"|longGradi = " & rsXLS.Fields("lonG").Value & Chr(10) & _
"|longMinuti = " & rsXLS.Fields("lonM").Value & Chr(10) & _
"|longSecondi = " & rsXLS.Fields("lonS").Value & Chr(10) & _
"|longEW = W" & Chr(10) & _
"|cap = " & rsXLS.Fields("CAP").Value & Chr(10) & _
"|telefono = " & rsXLS.Fields("Telefono").Value & Chr(10) & _
"|nomeabitanti =" & rsXLS.Fields("NomeAbitanti").Value & Chr(10) & _
"|sindaco =" & Chr(10) & _
"|sito =" & rsXLS.Fields("Sito").Value & Chr(10) & _
"|note =" & Chr(10) & _
"}}" & Chr(10) & Chr(10)
Voce3 = "'''" & rsXLS.Fields("Città").Value & "''' " & status & " degli [[Stati Uniti d'America]], " & _
"situata nella contea di [[" & rsXLS.Fields("ConteaWiki").Value & "|" & rsXLS.Fields("Contea").Value & "]], " & _
"nello stato del [[Mississippi]]." & Chr(10) & Chr(10) & _
"== Note ==" & Chr(10) & _
"<references/>" & Chr(10) & Chr(10) & _
"== Altri progetti ==" & Chr(10) & _
"{{interprogetto|commons=Category:" & rsXLS.Fields("Città").Value & ", Mississippi}}" & Chr(10) & Chr(10) & _
"== Collegamenti esterni ==" & Chr(10)
If rsXLS.Fields("Sito").Value <> "" Then
Voce4 = "*{{Cita web|url=" & rsXLS.Fields("Sito").Value & "|titolo=Sito ufficiale|lingua=en|accesso=23-07-2010}}" & Chr(10)
Else
Voce4 = ""
End If
Voce5 = "*{{Cita web|url=http://www.openstreetmap.org/?lat=" & latDec & "&lon=-" & lonDec & "&zoom=14|titolo=" & rsXLS.Fields("Città").Value & "|opera=OpenStreetMap|accesso=23-07-2010}}" & Chr(10) & _
"*{{Cita web|url=http://factfinder.census.gov/servlet/SAFFFacts?_event=Search&geo_id=&_geoContext=&_street=&_county=" & rsXLS.Fields("Città").Value & "&_cityTown=" & rsXLS.Fields("Città").Value & "&_state=04000US28&_zip=&_lang=en&_sse=on&pctxt=fph&pgsl=010&show_2003_tab=&redirect=Y" & _
"|titolo=" & rsXLS.Fields("Città").Value & " " & rsXLS.Fields("Status").Value & ", Mississippi" & "|opera=American Fact Finder|editore=U.S. Census Bureau|lingua=en|accesso=23-07-2010}}" & Chr(10) & Chr(10) & _
"{{Mississippi}}" & Chr(10) & Chr(10) & _
"{{Portale|Stati Uniti}}" & Chr(10) & Chr(10)
If rsXLS.Fields("Status").Value = "CDP" Then
Voce6 = "[[Categoria:Census-designated place del Mississippi]]" & Chr(10) & Chr(10) & _
"[[en:" & rsXLS.Fields("Città").Value & ", Mississippi]]"
Else
Voce6 = "[[Categoria:Comuni del Mississippi]]" & Chr(10) & Chr(10) & _
"[[en:" & rsXLS.Fields("Città").Value & ", Mississippi]]"
End If
Voce = Voce1 & Voce2 & Voce3 & Voce4 & Voce5 & Voce6
' Salva il file nel formato "Stato (nnn).txt"
Open percorso & "Missisippi (" & Format(rsXLS.Fields("N").Value, "000") & ") - " & rsXLS.Fields("Città").Value & ".txt" For Output As #1
Print #1, Voce
Close #1
rsXLS.MoveNext
Voce0 = ""
Voce1 = ""
Voce2 = ""
Voce3 = ""
Voce4 = ""
Voce5 = ""
Voce6 = ""
Voce = ""
Wend
Exit_CreaVoci:
' Chiude la connessione ADO e distrugge gli oggetti
ActiveWorkbook.Names("tblCittà").Delete
cnXLS.Close
Set rsXLS = Nothing
Set cnXLS = Nothing
Exit Sub
Gestore_Errori:
Debug.Print Err.Number
msg = MsgBox(Err.Number & " " & Err.Description)
Resume Exit_CreaVoci
End Sub