Aiutamici Forum
Benvenuto Ospite Cerca | Topic Attivi | Utenti | | Log In | Registra

Problemi con macro excel Opzioni
sly000
Inviato: Wednesday, December 11, 2013 1:01:36 PM
Rank: Member

Iscritto dal : 12/11/2013
Posts: 13
Ciao a tutti, avrei un problema da risolvere...
Ho un file excel contenente una macro che vorrei modificare...
Avrei bisogno che la mia macro mi chiedesse il numero di etichette da stampare ogni volta che scegliessi la destinazione..
Mi aiutate??? non so proprio come fare....
Grazie Anticipato!!!

Option Explicit
Dim LabText As String
Dim nElem As Integer
Dim Prov As String






Private Sub cmdAV_Click()
Dim a As Integer
Dim MyItem As String

lst1.Clear

For a = 1 To 50
MyItem = Cells.Range("K" & a).Value
lst1.AddItem MyItem
Next a
lst1.AddItem " "

cmdPrintOne.Caption = "Seleziona un elemento dalla lista"
cmdPrintALL.Caption = "Allestimento completo AVELLINO"
Prov = "AV"

nElem = 50
End Sub

Private Sub cmdPrintALL_Click()
Dim a As Integer
Dim p1, p2 As Integer
Dim MyItem As String
Dim nLab As Integer

Select Case Prov
Case "AV"
p1 = 1
p2 = 50
Case "BN"
p1 = 51
p2 = 72
Case "CE"
p1 = 73
p2 = 122
Case "NA"
p1 = 123
p2 = 186
Case "SA"
p1 = 187
p2 = 276
End Select

nLab = p2 - p1 + 1

If MsgBox("Questa scelta stamperà " & nLab & " etichette." & vbCr & "Confermi la scelta ?", vbQuestion + vbYesNo, "Attenzione. Richiesta di stampa di allestimento") = vbYes Then

For a = p1 To p2
LabText = Cells.Range("K" & a).Value
Worksheets("label").Range("A3").Value = LabText
ThisWorkbook.Sheets("label").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
''MsgBox "Stampo " & LabText
ThisWorkbook.Sheets("av").Select
Cells.Range("A1").Select
Next

End If

End Sub

Private Sub cmdPrintOne_Click()

Worksheets("label").Range("A3").Value = LabText
ThisWorkbook.Sheets("label").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ThisWorkbook.Sheets("av").Select
Cells.Range("A1").Select

End Sub


Private Sub cmdProvBN_Click()
Dim a As Integer
Dim MyItem As String

lst1.Clear
For a = 51 To 72
MyItem = Cells.Range("K" & a).Value
lst1.AddItem MyItem
Next a
lst1.AddItem " "
cmdPrintOne.Caption = "Seleziona un elemento dalla lista"
cmdPrintALL.Caption = "Allestimento completo BENEVENTO"
Prov = "BN"
End Sub

Private Sub cmdProvCE_Click()
Dim a As Integer
Dim MyItem As String

lst1.Clear
For a = 73 To 122
MyItem = Cells.Range("K" & a).Value
lst1.AddItem MyItem
Next a
lst1.AddItem " "
cmdPrintOne.Caption = "Seleziona un elemento dalla lista"
cmdPrintALL.Caption = "Allestimento completo CASERTA"
Prov = "CE"
End Sub

Private Sub cmdProvNA_Click()
Dim a As Integer
Dim MyItem As String

lst1.Clear
For a = 123 To 186
MyItem = Cells.Range("K" & a).Value
lst1.AddItem MyItem
Next a
lst1.AddItem " "
cmdPrintOne.Caption = "Seleziona un elemento dalla lista"
cmdPrintALL.Caption = "Allestimento completo NAPOLI"
Prov = "NA"
End Sub

Private Sub cmdProvSA_Click()
Dim a As Integer
Dim MyItem As String

lst1.Clear
For a = 187 To 276
MyItem = Cells.Range("K" & a).Value
lst1.AddItem MyItem
Next a
lst1.AddItem " "
cmdPrintOne.Caption = "Seleziona un elemento dalla lista"
cmdPrintALL.Caption = "Allestimento completo SALERNO"
Prov = "SA"
End Sub

Private Sub lst1_Click()
cmdPrintOne.Caption = "Stampa " & lst1.Text
LabText = lst1.Text

End Sub

Sponsor
Inviato: Wednesday, December 11, 2013 1:01:36 PM

 
wolfestein
Inviato: Wednesday, December 11, 2013 3:28:01 PM

Rank: AiutAmico

Iscritto dal : 2/15/2009
Posts: 15,955
Ti conviene spostare la richiesta nella sezione dedicata ad Office.
Utenti presenti in questo topic
Guest


Salta al Forum
Aggiunta nuovi Topic disabilitata in questo forum.
Risposte disabilitate in questo forum.
Eliminazione tuoi Post disabilitata in questo forum.
Modifica dei tuoi post disabilitata in questo forum.
Creazione Sondaggi disabilitata in questo forum.
Voto ai sondaggi disabilitato in questo forum.

Main Forum RSS : RSS

Aiutamici Theme
Powered by Yet Another Forum.net versione 1.9.1.8 (NET v2.0) - 3/29/2008
Copyright © 2003-2008 Yet Another Forum.net. All rights reserved.