Condividi:        

Aiutino per l'inserimento di un Range(X,Y)

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Aiutino per l'inserimento di un Range(X,Y)

Postdi cyber81 » 26/10/11 08:18

Salve ragazzi, mi sono appena iscritto al forum e ne approfitto per chidervi un'aiuto su una subroutine che attulamente utilizzo su un mio foglio excel:

Codice: Seleziona tutto
Sub Mail_Range6()
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("B6:AA6").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected. " & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
       
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
       
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "mia@email.it"
            .CC = ""
            .BCC = ""
            .Subject = "Pianificazione  ***" & Format(Date, "dd/mmmm/yyyy")
            .Body = "Buongiorno, in allegato alla Presente la pianificazione."
            .Attachments.Add Dest.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the e-mail message.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Praticamente questa Sub() prende le celle contenute nel range e le incolla in un nuovo file xls che allega alla mail che viene inviata qualora io clicchi un bottone. E' molto utile per cui se vi serve.. :))
Quello che chiedo è: come fare per inserire un nuovo rage per incollare nel nuovo file da allegare non una ma due righe? Ho provato a dichiarare prima una variabile nuova con DIM SOURCE1 e quindi via di seguito..ma non gira..

idee? Grazie!
cyber81
Utente Junior
 
Post: 32
Iscritto il: 26/10/11 08:09

Sponsor
 

Re: Aiutino per l'inserimento di un Range(X,Y)

Postdi Flash30005 » 26/10/11 10:25

Benvenuto nel Forum

Oltre alla Dim devi fare anche il Set Source1
come pure (eventuale) messaggio di errore

Codice: Seleziona tutto
   
 Set Source1 = Range("NuovoRange").SpecialCells(xlCellTypeVisible)
If Source1 Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected. " & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If


e la parte della routine Sorce1.copy
Codice: Seleziona tutto
    Source1.Copy
'nuovi campi destinazione
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With


Hai fatto tutto questo?
ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Aiutino per l'inserimento di un Range(X,Y)

Postdi cyber81 » 26/10/11 13:53

ciao grazie per la risposta, ti allego il codice aggiornato e ciò che accade:
Codice: Seleziona tutto
Sub Mail_Range6()
    Dim Source As Range
    Dim Source1 As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("B6:AA6").SpecialCells(xlCellTypeVisible)
    Set Source1 = Range("A4:AA4").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected. " & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
   
    Source1.Copy
    With Dest.Sheets(1)
        .Cells(2).PasteSpecial Paste:=8
        .Cells(2).PasteSpecial Paste:=xlPasteValues
        .Cells(2).PasteSpecial Paste:=xlPasteFormats
        .Cells(2).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
       
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
       
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "mia@mail.it"
            .CC = ""
            .BCC = ""
            .Subject = "Pianificazione MOD 7.5.1 ***" & Format(Date, "dd/mmmm/yyyy")
            .Body = "Buongiorno, in allegato alla Presente la pianificazione"
            .Attachments.Add Dest.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the e-mail message.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Adesso mi allega alla mail un foglio excel dove escono tutte le caselle del range B4:AA4 con in testa alla riga la prima cella del range B6:AA6...
Mentre avevo cambiato la subroutine in altro modo e mi creava due file differenti per i due range, ma uno lo allegava e l'altro no.

idee? :)
cyber81
Utente Junior
 
Post: 32
Iscritto il: 26/10/11 08:09

Re: Aiutino per l'inserimento di un Range(X,Y)

Postdi cyber81 » 27/10/11 10:33

OK così gira, mi allega preciso preciso le due righe che mi interessano (intestazione e un'altra variabile).
Siccome ogni giorno ha 1 riga, ho dovuto fare 31 macro per quanti sono i giorni del mese. Diciamo che ora il passo sarebbe capire come sia possibile fare un ciclo per automatizzare questa attività. Ma un "FOR" non mi va bene perchè a me interessa mandare la riga dove è presente il bottone che si clicca.

Idee ? :)

Codice: Seleziona tutto
Sub Mail_Range5()
    Dim Source As Range
    Dim Source1 As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source1 = Range("B4:Y4").SpecialCells(xlCellTypeVisible)
    Set Source = Range("B5:Y5").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected. " & _
               "Please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source1.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    Source.Copy
    With Dest.Sheets(1)
        .Cells(2, 1).PasteSpecial Paste:=8
        .Cells(2, 1).PasteSpecial Paste:=xlPasteValues
        .Cells(2, 1).PasteSpecial Paste:=xlPasteFormats
        .Cells(2, 1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
       
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
       
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "mia@mail.org"
            .CC = "tua@mail.org"
            .BCC = "sua@mail.org"
            .Subject = "Pianificazione" & Format(Date, "dd/mmmm/yyyy")
            .Body = "Buongiorno, in allegato alla Presente la pianificazione"
            .Attachments.Add Dest.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the e-mail message.
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
cyber81
Utente Junior
 
Post: 32
Iscritto il: 26/10/11 08:09

Re: Aiutino per l'inserimento di un Range(X,Y)

Postdi Flash30005 » 27/10/11 13:54

E' quasi assurdo avere 31 macro simili solo perché cambia il giorno
E' normale invece avere una unica macro che lavori con la variabile (o data o riga)
Bisogna solo sapere cosa cambia da un giorno all'altro
e questo solo tu lo sai
oppure invia due macro di due giorni consecutivi con le quali posso fare l'analisi e unificarle

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-


Torna a Applicazioni Office Windows


Topic correlati a "Aiutino per l'inserimento di un Range(X,Y)":


Chi c’è in linea

Visitano il forum: Nessuno e 46 ospiti