domandone
come posso spostare dati da una tabella xls ad un modulo precompilato di word ?
con una macro o altro modo ?
vi ringrazio
link ai due file
https://www.wetransfer.com/downloads/3c ... 927/fca4f5
Moderatori: Anthony47, Flash30005
Sub matTables()
Dim OBJWord As Object, OBJDoc As Object
Dim myFIle As String, SrcSh As Worksheet, I As Long
Dim aMats, aCols, myMatch, matRow As Long, cMat As String
'
myFIle = "C:\Users\PERCORSO\PMI - CERTIFICATE.doc" '<<< Il file Word da leggere
Set SrcSh = ThisWorkbook.Sheets("Foglio1") '<<< Il foglio di Excel da dove prelevare
matRow = 5 '<<< La riga con le intestazioni dei materiali
'
aMats = Array("Mn", "Cu", "W", "V", "Zr")
aCols = Array(9, 10, 11, 12, 13)
'
'Set OBJWord = New Word.Application 'EARLY BINDING
Set OBJWord = CreateObject("Word.Application") 'LATE BINDING
'
OBJWord.Visible = True
Set OBJDoc = OBJWord.Documents.Open(Filename:=myFIle)
With OBJDoc.Tables(2)
For I = LBound(aMats) To UBound(aMats)
cMat = aMats(I)
myMatch = Application.Match(cMat, Rows(matRow), 0)
If Not IsError(myMatch) Then
.Cell(2, aCols(I)).Range.Text = cMat
.Cell(3, aCols(I)).Range.Text = Cells(matRow + 3, myMatch)
End If
Next I
If InStrRev(Cells(4, 1), "SN", , vbTextCompare) > 0 Then
.Cell(3, 2) = Mid(Cells(4, 1), InStr(1, Cells(4, 1), "Seat", vbTextCompare), _
InStrRev(Cells(4, 1).Value, "SN", , vbTextCompare) - InStr(1, Cells(4, 1).Value, "Seat", vbTextCompare))
.Cell(3, 1) = Mid(Cells(4, 1), InStrRev(Cells(4, 1), "SN", , vbTextCompare))
End If
End With
MsgBox ("Controlla compilazione documento Word e salvalo con nuovo nome")
Stop
'Completato:
On Error Resume Next
OBJDoc.Close False
OBJWord.Quit
Set OBJWord = Nothing
On Error GoTo 0
End Sub
Sub WmatTables()
Dim ObjXL As Object, ObjWkb As Object, CopiaDa As String
Dim myFIle As String, SrcSh As Object, I As Long
Dim aMats, aCols, myMatch, matRow As Long, cMat As String
'
myFIle = "C:\Users\PERCORSO\Cartel1.xls" '<<< Il file Excel da cui leggere
CopiaDa = "Foglio1" '<<< Il foglio Excel da cui leggere
matRow = 5 '<<< La riga con le intestazioni dei materiali
'
aMats = Array("Mn", "Cu", "W", "V", "Zr")
aCols = Array(9, 10, 11, 12, 13)
'
'Set ObjXL = New Excel.Application 'EARLY BINDING
Set ObjXL = CreateObject("excel.Application") 'LATE BINDING
'
ObjXL.Visible = True
On Error Resume Next
Set ObjWkb = ObjXL.Workbooks.Open(FileName:=myFIle)
If ObjWkb Is Nothing Then
MsgBox ("Impossibile aprire il file Excel; chiuderlo se gia' aperto e riprovare")
GoTo Term
End If
Set SrcSh = ObjWkb.Sheets(CopiaDa)
With ThisDocument.Tables(2)
For I = LBound(aMats) To UBound(aMats)
cMat = aMats(I)
myMatch = SrcSh.Application.Match(cMat, SrcSh.Rows(matRow), 0)
If Not IsError(myMatch) Then
.Cell(2, aCols(I)).Range.Text = cMat
.Cell(3, aCols(I)).Range.Text = SrcSh.Cells(matRow + 3, myMatch)
End If
Next I
If InStrRev(SrcSh.Cells(4, 1), "SN", , vbTextCompare) > 0 Then
.Cell(3, 2).Range.Text = Mid(SrcSh.Cells(4, 1), InStr(1, SrcSh.Cells(4, 1), "Seat", vbTextCompare), _
InStrRev(SrcSh.Cells(4, 1).Value, "SN", , vbTextCompare) - InStr(1, SrcSh.Cells(4, 1).Value, "Seat", vbTextCompare))
.Cell(3, 1).Range.Text = Mid(SrcSh.Cells(4, 1), InStrRev(SrcSh.Cells(4, 1), "SN", , vbTextCompare))
End If
End With
MsgBox ("Controlla compilazione documento Word rispetto a Excel")
Stop '<<< Si potra' togliere quando confidenti che il risultato e' Ok
'Completato:
Term:
On Error Resume Next
ObjWkb.Close False
ObjXL.Quit
Set ObjXL = Nothing
Set ObjWkb = Nothing
On Error GoTo 0
End Sub
Torna a Applicazioni Office Windows
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 5 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Inserimento dati su tabella da codice a barre Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 80 |
Visitano il forum: Nessuno e 53 ospiti