Vbs - Vba - Visual Basic Scripting - Visual Basic for Applications: marzo 2013

giovedì 14 marzo 2013

evidenzia ricerca valori

Attribute VB_Name = "evidenzia_ricerca_valori"

'

Option Explicit

'

' vba - Excel

' Evidenzia Valori Colonna Per Contenuto

' ricerca ed evidenzia cella in base al contenuto utilizzando una espressione regolare

' alternativa leggera alla formattazione condizionale

'

Sub uso_EvidenziaValoriColonnaPerContenuto()

'

Dim nomefoglio, colonnaricerca, datoricercato

Dim campi, ritorno

campi = Array("", "nome foglio", "colonna ricerca", "dato ricercato")

ritorno = creaMaskeraHtml(campi)

'

nomefoglio = ritorno(1)

colonnaricerca = ritorno(2)

datoricercato = ritorno(3)

'

Call EvidenziaValoriColonnaPerContenuto(nomefoglio, colonnaricerca, datoricercato)

'

End Sub

'

Sub EvidenziaValoriColonnaPerContenuto(nomefoglio, colonnaricerca, datoricercato)

Dim procedura, cella As Range, foglio, zonaricerca, quanterighe

Set foglio = Sheets(nomefoglio)

' conteggio righe utilizzate

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).row

'

Set zonaricerca = foglio.Range(Cells(1, colonnaricerca), Cells(quanterighe, colonnaricerca))

Set procedura = CreateObject("VBScript.RegExp")

'

With procedura

.Pattern = datoricercato

.IgnoreCase = True

.Global = True

For Each cella In zonaricerca

If .test(cella.Value) Then

cella.Interior.ColorIndex = 6

End If

Next cella

End With

'

Set procedura = Nothing

'

End Sub

'

Function creaMaskeraHtml(campi)

'

On Error GoTo esci

'

Dim txtHtml, IE, valoriinput, quanticampi, contacampi

quanticampi = UBound(campi)

ReDim ritorno(quanticampi)

ritorno(0) = "errore"

'

Set IE = CreateObject("InternetExplorer.Application")

IE.navigate "about:blank"

IE.Top = 150

IE.Visible = True

IE.Height = 300

IE.Width = 550

IE.MenuBar = False

IE.Toolbar = False

IE.StatusBar = False

IE.resizable = True

'

IE.document.Title = " - ricerca - "

' crea codice HTML della pagina per input dei valori.

' utilizzando una form e una tabella

txtHtml = ""

txtHtml = txtHtml + "<html><body><center>"

txtHtml = txtHtml + " inserimento<br>"

txtHtml = txtHtml + "<FORM name=""mask""><table>"

For contacampi = 1 To quanticampi

txtHtml = txtHtml + "<TR>" ' crea nuova riga

txtHtml = txtHtml + "<TD>" ' crea colonna della descrizione

txtHtml = txtHtml + campi(contacampi) ' testo visualizzato

txtHtml = txtHtml + ":</TD><TD>" ' nuova colonna

txtHtml = txtHtml + "<input name=""" & campi(contacampi) & """ type=""text"" value="""">" ' box input

txtHtml = txtHtml + "</TD></TR>"

Next contacampi

txtHtml = txtHtml + "</table></FORM></body></html>"

IE.document.body.innerHTML = txtHtml

'

' Do While IE.readyState = 4: DoEvents: Loop

'

Do While IE.readystate = 4

'

contacampi = 0

For Each valoriinput In IE.document.all.tags("INPUT")

contacampi = contacampi + 1

ritorno(contacampi) = valoriinput.Value

Next

'

DoEvents

Loop

'

ritorno(0) = "risposta"

Set IE = Nothing

'

esci:

'

creaMaskeraHtml = ritorno

'

End Function

'

'

importazione listino metel

Attribute VB_Name = "importazione_listino_metel"

'

Option Explicit

'

' vba - procedura completa per importazione listino Metel

' inserisce intestazione campi/colonne

' dividi i prezzi per ottenere i due decimali

' inserisce in un foglio a parte la testata del listino

'

Sub ImportaListinoMetel()

'

' scelta file

Dim archivio

archivio = Application.GetOpenFilename("Tutti i file (*.*), *.*")

If archivio = False Then

Exit Sub

End If

'

Sheets.Add

Dim rigaletta, fso, f, sriga

' assegna il formato celle testo

Columns("A:D").Select

Selection.NumberFormat = "@"

Rows("2:2").Select

ActiveWindow.FreezePanes = True

sriga = 0

' legge il file di testo

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(archivio, 1, False)

Do While f.AtEndOfStream <> True

rigaletta = f.ReadLine

sriga = sriga + 1

ActiveSheet.Cells(sriga, 1) = rigaletta

Loop

f.Close

' analizza testo in colonne

ActiveSheet.Columns("A:A").Select

' tracciato record del listino metel

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _

FieldInfo:=Array(Array(0, 1), _

Array(3, 2), Array(19, 2), Array(32, 1), Array(75, 1), Array(80, 1), Array(85, 1), Array _

(90, 1), Array(96, 1), Array(97, 1), Array(108, 1), Array(119, 1), Array(125, 1), Array(128 _

, 1), Array(131, 1), Array(132, 1), Array(133, 5), Array(141, 2), Array(159, 2))

' divide i prezzi per inserire i due decimali

Dim quanterighe, contarighe, prezzogg, nprezzogg, prezzorr, nprezzorr, divisore, foglio

Set foglio = Sheets(ActiveSheet.Name)

divisore = 100 ' per i due decimali del prezzo grossista e al pubblico

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).row

'

For contarighe = 1 To quanterighe

prezzogg = ActiveSheet.Cells(contarighe, "J").Value ' prezzo grossista

prezzorr = ActiveSheet.Cells(contarighe, "K").Value ' prezzo al pubblico

If IsNull(prezzogg) = False And IsNumeric(prezzogg) = True Then

nprezzogg = prezzogg / divisore

ActiveSheet.Cells(contarighe, "J").Value = nprezzogg

End If

If IsNull(prezzorr) = False And IsNumeric(prezzorr) = True Then

nprezzorr = prezzorr / divisore

ActiveSheet.Cells(contarighe, "k").Value = nprezzorr

End If

Next

Sheets(ActiveSheet.Name).Name = "listino"

' inserisce i nomi dei campi

Call testatalistinometel("listino")

'

Columns("A:S").Select

Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("B2").Select

'

End Sub

'

Sub testatalistinometel(nomefoglio)

'

Sheets(nomefoglio).Cells(1, 1) = "Sigla Marchio"

Sheets(nomefoglio).Cells(1, 2) = "Codice Prodotto Produttore"

Sheets(nomefoglio).Cells(1, 3) = "Codice EAN"

Sheets(nomefoglio).Cells(1, 4) = "Descrizione prodotto"

Sheets(nomefoglio).Cells(1, 5) = "Quantità cartone"

Sheets(nomefoglio).Cells(1, 6) = "Quantità multipla ordinazione"

Sheets(nomefoglio).Cells(1, 7) = "Quantità minima ordinazione"

Sheets(nomefoglio).Cells(1, 8) = "Quantità massima ordinazione"

Sheets(nomefoglio).Cells(1, 9) = "Lead Time"

Sheets(nomefoglio).Cells(1, 10) = "Prezzo al grossista"

Sheets(nomefoglio).Cells(1, 11) = "Prezzo al Pubblico"

Sheets(nomefoglio).Cells(1, 12) = "Moltiplicatore prezzo"

Sheets(nomefoglio).Cells(1, 13) = "Codice Valuta"

Sheets(nomefoglio).Cells(1, 14) = "Unità di misura"

Sheets(nomefoglio).Cells(1, 15) = "Prodotto Composto"

Sheets(nomefoglio).Cells(1, 16) = "Stato del prodotto"

Sheets(nomefoglio).Cells(1, 17) = "Data ultima variazione"

Sheets(nomefoglio).Cells(1, 18) = "Famiglia di sconto"

Sheets(nomefoglio).Cells(1, 19) = "Famiglia statistica"

End Sub

'

Sub leggitesta(archivio)

Sheets.Add

Sheets(ActiveSheet.Name).Name = "testatalistino"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s, campo, conta

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFile(archivio)

Set ts = f.OpenAsTextStream(ForReading, TristateFalse)

s = ts.ReadLine

ts.Close

Dim posizioni, lunghezze, sriga

Dim posizione, lungo

posizioni = Array(1, 21, 24, 35, 41, 49, 57, 87, 126, 129)

lunghezze = Array(20, 3, 11, 6, 8, 8, 30, 39, 3, 49)

Dim nomicampi(10)

nomicampi(0) = "Identificazione tracciato"

nomicampi(1) = "sigla produttore"

nomicampi(2) = "Partita IVA"

nomicampi(3) = "Numero listino prezzi"

nomicampi(4) = "Decorrenza listino prezzi"

nomicampi(5) = "Data ultima variazione/immissione"

nomicampi(6) = "Descrizione listino prezzi"

nomicampi(7) = "spazio1"

nomicampi(8) = "Versione tracciato listino prezzi"

nomicampi(9) = "spazio2"

'

For conta = 0 To 9

posizione = posizioni(conta)

lungo = lunghezze(conta)

sriga = conta + 1

campo = "'" & Mid(s, posizione, lungo)

Sheets("testatalistino").Cells(sriga, 2) = nomicampi(conta)

Sheets("testatalistino").Cells(sriga, 3) = campo

Next conta

'

End Sub

'

Sub vedifoglio(nomefoglio)

On Error GoTo crea

Sheets(nomefoglio).Activate

Sheets(nomefoglio).Delete

crea:

Sheets.Add

Sheets(ActiveSheet.Name).Name = nomefoglio

'

End Sub

'

'

'

mercoledì 13 marzo 2013

maschera input valori html

Attribute VB_Name = "maschera_input_valori_html"

'

Option Explicit

'

' vba - crea finestra per input valori utilizzando Internet Explorer

'

Sub uso_MaskHtml_usa_valori()

Dim campi, ritorno

campi = Array("", "codice", "descrizione", "prezzo")

ritorno = creaMaskeraHtml(campi)

'

Dim valori1, valori2, valori3

'

valori1 = ritorno(1)

valori2 = ritorno(2)

valori3 = ritorno(3)

'

MsgBox valori1 & vbCrLf & valori2 & vbCrLf & valori3

'

End Sub

'

'

Sub uso_MaskHtml_elenca_valori()

Dim campi, ritorno

campi = Array("", "codice", "descrizione", "note", "prezzo")

ritorno = creaMaskeraHtml(campi)

'

Dim conta, quanti

quanti = UBound(ritorno)

For conta = 1 To quanti

ActiveSheet.Cells(conta, "a").Value = campi(conta)

ActiveSheet.Cells(conta, "b").Value = ritorno(conta)

Next conta

'

End Sub

'

Function creaMaskeraHtml(campi)

'

On Error GoTo esci

'

Dim txtHtml, ie, valoriinput, quanticampi, contacampi

quanticampi = UBound(campi)

ReDim ritorno(quanticampi)

ritorno(0) = "errore"

'

Set ie = CreateObject("InternetExplorer.Application")

ie.navigate "about:blank"

ie.Top = 150

ie.Visible = True

ie.Height = 300

ie.Width = 550

ie.MenuBar = False

ie.Toolbar = False

ie.StatusBar = False

ie.resizable = True

'

ie.document.Title = " - inserimento valori - "

' crea codice HTML della pagina per input dei valori.

' utilizzando una form e una tabella

txtHtml = ""

txtHtml = txtHtml + "<html><body><center>"

txtHtml = txtHtml + " inserimento<br>"

txtHtml = txtHtml + "<FORM name=""mask""><table>"

For contacampi = 1 To quanticampi

txtHtml = txtHtml + "<TR>" ' crea nuova riga

txtHtml = txtHtml + "<TD>" ' crea colonna della descrizione

txtHtml = txtHtml + campi(contacampi) ' testo visualizzato

txtHtml = txtHtml + ":</TD><TD>" ' nuova colonna

txtHtml = txtHtml + "<input name=""" & campi(contacampi) & """ type=""text"" value="""">" ' box input

txtHtml = txtHtml + "</TD></TR>"

Next contacampi

txtHtml = txtHtml + "</table></FORM></body></html>"

ie.document.body.innerHTML = txtHtml

'

' Do While IE.readyState = 4: DoEvents: Loop

'

Do While ie.readyState = 4

'

contacampi = 0

For Each valoriinput In ie.document.all.tags("INPUT")

contacampi = contacampi + 1

ritorno(contacampi) = valoriinput.Value

Next

'

DoEvents

Loop

'

ritorno(0) = "risposta"

Set ie = Nothing

'

esci:

'

creaMaskeraHtml = ritorno

'

End Function

'

'

cancella righe scadute per data

Attribute VB_Name = "cancella_righe_scadute_per_data"

'

Option Explicit

'

' vba - Cancella Righe Scadute Per Data

'

Sub CancellaRigheScadutePerData()

'

Dim txtinfo, colonnaselezionata, corrente, lungo, quanterighe, contarighe

Dim oggi As Date, foglio

Set foglio = Sheets(ActiveSheet.Name)

txtinfo = "cancella righe scadute" & vbCrLf & "data inferiore ad oggi"

'

colonnaselezionata = InputBox(txtinfo, "scegli colonna")

'

Application.Cursor = xlWait

Application.ScreenUpdating = False

'

oggi = Date

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

' verifica la presenza del dato

lungo = Len(Trim(colonnaselezionata))

If lungo = 0 Then

Exit Sub

End If

'

For contarighe = quanterighe To 1 Step -1

corrente = Trim(foglio.Cells(contarighe, colonnaselezionata).Value)

If IsDate(corrente) = True Then

If corrente < oggi Then

foglio.Rows(contarighe).Delete

End If

End If

'

Next contarighe

'

Application.ScreenUpdating = True

Application.Cursor = xlDefault

'

End Sub

martedì 12 marzo 2013

leggi ipconfig linea comando

Attribute VB_Name = "leggi_ipconfig_linea_comando"

'

Option Explicit

'

' vba - Leggi Ipconfig Linea Di Comando

'

'

Sub LeggiIpconfigLineaDiComando()

Sheets.Add

Dim riga

Dim proShell, Linecomando, txtstringa

Set proShell = CreateObject("WScript.Shell")

Set Linecomando = proShell.Exec("%comspec% /c ipconfig.exe /all")

'

Do Until Linecomando.StdOut.AtEndOfStream

txtstringa = Linecomando.StdOut.ReadLine()

riga = riga + 1

txtstringa = Replace(txtstringa, Chr(13), "")

ActiveSheet.Cells(riga, 1).Value = txtstringa

Loop

'

End Sub

ricerca evidenzia contenuto

Attribute VB_Name = "ricerca_evidenzia_contenuto"

'

Option Explicit

'

' vba - ricerca ed evidenzia cella in base al contenuto utilizzando una espressione regolare

'

Sub EvidenziaCellaPerContenuto()

Dim procedura, testodaricercare As String, cella As Range

Set procedura = CreateObject("VBScript.RegExp")

testodaricercare = InputBox("cosa deve contenere la cella:", "scelta", "")

With procedura

.Pattern = testodaricercare

.IgnoreCase = True

.Global = True

For Each cella In ActiveSheet.UsedRange

If .test(cella.Value) Then cella.Interior.ColorIndex = 3

Next cella

End With

Set procedura = Nothing

'

End Sub

'

lunedì 11 marzo 2013

finestra messaggio html

Attribute VB_Name = "finestra_messaggio_html"

'

Option Explicit

'

' vba - funzione finestra messaggio in html - v. 1.0

'

'

Sub uso_FinestraMessaggioHtml()

Dim testomessaggio

testomessaggio = ""

testomessaggio = testomessaggio & "prima riga msg" & vbCrLf

testomessaggio = testomessaggio & "seconda riga msg" & vbCrLf

testomessaggio = testomessaggio & "terza riga msg" & vbCrLf

'

Call FinestraMessaggioHtml(testomessaggio)

'

End Sub

'

Sub FinestraMessaggioHtml(testomessaggio)

'

Dim testo

testo = Replace(testomessaggio, vbCrLf, "<br>")

'

Dim istrhtml, ie As Object

Set ie = CreateObject("InternetExplorer.Application")

ie.navigate "about:blank" ' do this first!

ie.Visible = True

ie.Height = 350

ie.Width = 550

ie.MenuBar = False

ie.Toolbar = False

ie.StatusBar = False

ie.resizable = True

' istruzioni html

istrhtml = ""

istrhtml = istrhtml + "<html>"

istrhtml = istrhtml + "<head><title></title>"

istrhtml = istrhtml + "</head><body><center><br><strong></strong><br>"

istrhtml = istrhtml + testo ' testo del messaggio

istrhtml = istrhtml + "</center></body></html>"

ie.document.body.innerHTML = istrhtml

Set ie = Nothing

'

End Sub

importa listno metel

Attribute VB_Name = "importa_listno_metel"

'

Option Explicit

'

' vba - importa un listino Metel in un nuovo foglio

'

Sub LeggeFileListinoMetel()

'

Const ForReading = 1

Const ForWriting = 2

'

Dim elencocampi, objFSO, objFile, rigacaricata, lunghezzariga, rigalavorata, dadove

Dim foglio, riga, colonna

'

elencocampi = Array(3, 16, 13, 43, 5, 5, 5, 6, 1, 11, 11, 6, 3, 3, 1, 1, 8, 18, 18) ' tracciato listino metel

'

Sheets.Add

Set foglio = Sheets(ActiveSheet.Name)

riga = 0

colonna = 0

'

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile("c:\listinometel-LSG.txt", ForReading)

'

Do Until objFile.AtEndOfStream

rigacaricata = objFile.ReadLine

lunghezzariga = Len(rigacaricata)

riga = riga + 1

colonna = 0

dadove = 1

For Each rigalavorata In elencocampi

colonna = colonna + 1

foglio.Cells(riga, colonna).Value = "'" & Mid(rigacaricata, dadove, rigalavorata)

dadove = dadove + rigalavorata

Next

Loop

'

objFile.Close

'

Cells.Select

Cells.EntireColumn.AutoFit

Rows("2:2").Select

ActiveWindow.FreezePanes = True

'

End Sub

venerdì 8 marzo 2013

Excel conteggio righe colonne

Attribute VB_Name = "Excel_conteggio_righe_colonne"

'

Option Explicit

'

Sub uso_conteggiorighecolonne()

Dim nomefoglio

nomefoglio = "articoli"

MsgBox "Righe utilizzate: " & conteggiorighecolonne(nomefoglio, "righe")

MsgBox "colonne utilizzate: " & conteggiorighecolonne(nomefoglio, "colonne")

End Sub

'

Function conteggiorighecolonne(nomefoglio, cosa)

' funzione conteggio righe e colonne usate su un foglio excel

Dim foglio, quanterighe, quantecolonne

conteggiorighecolonne = 0

Set foglio = Sheets(nomefoglio)

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

quantecolonne = Range(foglio.UsedRange.Cells(1, foglio.UsedRange.Columns.Count).Address).Column

'

If cosa = "righe" Then

conteggiorighecolonne = quanterighe

Else

conteggiorighecolonne = quantecolonne

End If

'

End Function

mercoledì 6 marzo 2013

Excel macro. Ampliare le funzionalità di Excel con funzioni e programmazione

L'informatica è sempre più presente, nelle attività lavorative come nella vita quotidiana, mentre il tempo che si può dedicare allo studio e alla formazione è sempre più ridotto. Tra gli argomenti affrontati nel volume: Sfruttare le potenzialità delle macro di Excel nelle versioni 97, 2000, 2002, 2003; Registare una macro; Dietro le macro: il linguaggio Visual Basic for Application (VEA); Visual Basic Editor; Macro funzioni, routine e subroutine; Tipi, variabili, matrici e costanti; Esecuzione condizionale e ciclica delle istruzioni; Creare finestre di dialogo.

Excel macro 2010

Il linguaggio VBA, potenzialità generalmente poco sfruttata in Excel, permette di automatizzare, personalizzare e ottenere il massimo delle prestazioni dai fogli di calcolo. Questo libro permette sia ai programmatori esperti sia agli utenti alle prime armi di avvicinarsi a queste funzionalità. Passo dopo passo si verrà guidati nella costruzione di macro, passando dalle operazioni più semplici fino alla realizzazione di applicazioni complesse. Il testo è aggiornato alla versione 2010 di Excel.

VBScript in a Nutshell: A Desktop Quick Reference (In a NutshellVBScript in aVBScript in a Nutshell: A Desktop Quick Reference

VBScript in a Nutshell: A Desktop Quick Reference (In a Nutshell)
Lightweight yet powerful, VBScript from Microsoft® is used in four main areas: server-side web applications using Active Server Pages (ASP), client-side web scripts using Internet Explorer, code behind Outlook forms, and automating repetitive tasks using Windows Script Host (WSH). VBScript in a Nutshell, Second Edition delivers current and complete documentation for programmers and system administrators who want to develop effective scripts. Completely updated for VBScript 5.6, WSH 5.6 and ASP 3.0, VBScript In a Nutshell, Second Edition includes updated introductory chapters that will help you keep current with the significant changes since the first edition was published. New chapters introduce the Windows Script Component for creating binary COM components, and the Script Encoder.

Excel. Dalle basi al VBA

Il testo inizia con le basi di Excel: l'interfaccia, il foglio di calcolo e le cartelle. Vengono poi approfondite le formule, le pivot e le funzioni, fino ad arrivare alla creazione dei grafici e alle potenzialità delle macro e del VBA. Un particolare riguardo è dato alla sicurezza. Ogni capitolo è corredato da esempi pratici.

Microsoft Excel 2010 macro e VBA

La suite da ufficio Microsoft Office è sicuramente uno dei software più diffusi al mondo, molti ne apprezzano le potenzialità, ma tanti ignorano che è possibile estenderne le capacità per adeguarla alle proprie necessità. Tutto questo è possibile grazie a VBA (Visual Basic for Applications), un linguaggio di programmazione appartenente alla famiglia del Visual Basic.Questo libro, rivolto a utenti mediamente evoluti di Excel, a manager, consulenti e formatori, illustra con chiarezza e mediante esercitazioni concrete l’utilizzo di macro e VBA per espandere le potenzialità di Excel.Anche chi non ha esperienza di programmazione potrà trovare in questo libro spunti interessanti per incrementare le capacità e la flessibilità dei suoi fogli di calcolo, oltre che per iniziare a familiarizzare con il linguaggio VBA in quanto tale. È richiesta solamente una discreta conoscenza di Excel, per il resto le istruzioni sono fornite passo passo, in modo da guidare tutti a realizzare i progetti proposti dal libro.