Moderatori: Anthony47, Flash30005
Anthony47 ha scritto:Tutte le cose che dici si possono fare col vba, partendo dall'estrazione degli allegati delle mail se ricevute tramite Outlook (un esempio e' qui: http://www.pc-facile.com/forum/viewtopi ... 2#p641302)
Sub AssegnaPackingList()
'
' AssegnaPackingList Macro
'
'
Range("D5").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"..\..\docuenti%20vari\30aecc7b-f380-400e-953f-c6ee2ab5b515_6339_shipment_label.pdf" _
, TextToDisplay:="I4S0016/02"
Range("D5").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"..\..\docuenti%20vari\30aecc7b-f380-400e-953f-c6ee2ab5b515_6339_shipment_label.pdf" _
, TextToDisplay:="I4S0016/02"
'Dichiarazione in testa al modulo vba:
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
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
#End If
'codice all'interno della macro:
strFileName = "C:\Percorso\NomeFile.pdf"
myPid = ShellExecute(vbNull, "Open", strFileName, "", "", vbMaximizedFocus)
Private Sub CommandButton1_Click()
Dim myFile As String
myFile = Application.GetOpenFilename(filefilter:="File di Adobe Acrobat Reader,*.pdf", Title:="Indica il file da collegare")
If myFile = "Falso" Then Exit Sub
ActiveSheet.Hyperlinks.Add _
Anchor:=Range("D5"), _
Address:=myFile, _
TextToDisplay:="" & Range("D5")
End Sub
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Paste
Sub registra()
'
' registra Macro
'
'
Sheets("REGISTRO").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Range("A2").Select
Sheets("SCHEDA").Select
Range("D5").Select
Selection.Copy
Sheets("REGISTRO").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B6").Select
Sheets("SCHEDA").Select
Range("D5:D17").Select
Range("D17").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("D5").Select
End Sub
Sub registra()
'
' registra Macro
'
'
Sheets("REGISTRO").Select
Rows("2:2").Select
Selection.Insert Copy
Range("A2").Select
Sheets("SCHEDA").Select
Range("D5").Select
Selection.Copy
Sheets("REGISTRO").Select
Selection.Paste
Sheets("SCHEDA").Select
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SCHEDA").Select
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("REGISTRO").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B6").Select
Sheets("SCHEDA").Select
Range("D5:D17").Select
Range("D17").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("D5").Select
End Sub
Sub registra()
'
' registra Macro
'
'
Sheets("REGISTRO").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Range("A2").Select
'Siamo su foglio REGISTRO
Sheets("SCHEDA").Range("D5").Copy Destination:=Range("A2")
'' Range("A2").Value = Sheets("SCHEDA").Range("D5").Value
Range("B2").Value = Sheets("SCHEDA").Range("D7").Value
Range("C2").Value = Sheets("SCHEDA").Range("D9").Value
Range("D2").Value = Sheets("SCHEDA").Range("D11").Value
Range("E2").Value = Sheets("SCHEDA").Range("D13").Value
Range("F2").Value = Sheets("SCHEDA").Range("D15").Value
Range("G2").Value = Sheets("SCHEDA").Range("D17").Value
Sheets("SCHEDA").Select
Range("D5:D17").ClearContents
Range("D5").Select
Selection.Hyperlinks(1).Delete
End Sub
Anthony47 ha scritto:Mi sembra di capire:
-aggiungi regolarmente l'hyperlink alla cella D5 del foglio SCHEDA
-ma quando fai copia /incolla-valore su foglio REGISTRO il collegamento viene perduto
Ma perché fai copia /incolla-valore, non puoi fare Copia /Incolla?
Se questo e' possibile, allora tutta la tua Sub registra potrebbe diventare (evitando anche gli avanti e indietro):
- Codice: Seleziona tutto
Sub registra()
'
' registra Macro
'
'
Sheets("REGISTRO").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Range("A2").Select
'Siamo su foglio REGISTRO
Sheets("SCHEDA").Range("D5").Copy Destination:=Range("A2")
'' Range("A2").Value = Sheets("SCHEDA").Range("D5").Value
Range("B2").Value = Sheets("SCHEDA").Range("D7").Value
Range("C2").Value = Sheets("SCHEDA").Range("D9").Value
Range("D2").Value = Sheets("SCHEDA").Range("D11").Value
Range("E2").Value = Sheets("SCHEDA").Range("D13").Value
Range("F2").Value = Sheets("SCHEDA").Range("D15").Value
Range("G2").Value = Sheets("SCHEDA").Range("D17").Value
Sheets("SCHEDA").Select
Range("D5:D17").ClearContents
Range("D5").Select
Selection.Hyperlinks(1).Delete
End Sub
'' Range("A2").Value = Sheets("SCHEDA").Range("D5").Value
Selection.Hyperlinks(1).Delete
myFile = Application.GetOpenFilename(filefilter:="File di Adobe Acrobat Reader,*.pdf", Title:="Indica il file da collegare")
myFile = Application.GetOpenFilenamefilter = "Word and Adobe Acrobat Reader Files (*.doc;*.docx;*.pdf),*.doc;*.docx;*.pdf"
myFile = Application.GetOpenFilenamefilter = "Word and Adobe Acrobat Reader Files (*.doc;*.docx;*.pdf),*.doc;*.docx;*.pdf"
myFile = Application.GetOpenFilename = "Word and Adobe Acrobat Reader Files (*.doc;*.docx;*.pdf),*.doc;*.docx;*.pdf"
myFile = Application.GetOpenFilename(filefilter:="Word and Adobe Acrobat Reader Files (*.doc;*.docx;*.pdf),*.doc;*.docx;*.pdf")
If Target.Address = "$D$5" Then
myPath = "C:\questo\"
ElseIf Target.Address = "$D$13" Then
myPath = "C:\codesto\"
ElseIf Target.Address = "$D$17" Then
myPath = "C:\quello\"
End If
If Target.Address = "$D$5" Then
myPath = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE\"
ElseIf Target.Address = "$D$13" Then
myPath = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE\ISTRUZIONI\P.LIST\"
ElseIf Target.Address = "$D$17" Then
myPath = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE\ISTRUZIONI"
End If
ActiveSheet.Hyperlinks.Add _
Anchor:=Target, _
Address:=myFile, _
TextToDisplay:="" & Target.Value & ""
Torna a Applicazioni Office Windows
Consiglio su come gestire le pratiche chiuse Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 19 |
Click per copiare una riga tabella Autore: marte1503 |
Forum: Applicazioni Office Windows Risposte: 39 |
Visitano il forum: Nessuno e 12 ospiti