Cancellare contenuto tra due segnalibri

Hai un problema con Excel?

Nuova discussione

Cancellare contenuto tra due segnalibri
di andre (utente non iscritto) data: 26/04/2013 11:04:23
tramite una macro scritta in Excel dovrei cancellare il contenuto compreso tra due segnalibri di un file word. grazie in anticipo per l'aiuto!!!

di andre (utente non iscritto) data: 26/04/2013 11:10:30
vi allego anche il codice che ho fatto e l'istruzione che avrei in mente di fare per eliminare il contenuto tra i segnalibri chiamati "primo" e "secondo"

Public Sub m()

On Error GoTo RigaErrore

     Dim objWord As Object
     Dim objDoc As Object
     Dim sPath As String
     Dim sNomeFile As String
     Dim sh As Worksheet
     Dim lRiga As Long
     Dim lng As Long
     Dim controllo As Variant
     Dim controllo2 As Variant
     
     Set sh = ThisWorkbook.Worksheets("Foglio1")
     sPath = "C:UsersamaistoDesktop"
     sNomeFile = "doc1.docx"
     
     With sh
     
         lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
         Set objWord = CreateObject("Word.Application")
         For lng = 2 To lRiga
         
            If Dir(sPath) <> "" Then
                 
                 Set objDoc = objWord.Documents.Open(sPath & sNomeFile)
                 controllo = Range("A" & lng).Value
                 controllo2 = Range("B" & lng).Value
                 If controllo = controllo2 Then
                    
                    objDoc.Bookmarks("A" & lng).Range.Text = .Range("A" & lng).Value
                    objDoc.Bookmarks("B" & lng).Range.Text = .Range("B" & lng).Value
                    objDoc.Range(.Bookmarks("primo").Range.End, .Bookmarks("secondo").Range.Start).Delete
                 End If
                 
                 'objWord.Visible = True
                 
             End If
         Next
    
     objDoc.SaveAs (sPath & "Aggiornato" & ".docx")
     objDoc.Close
     Set objDoc = Nothing
     End With
     
RigaChiusura:
     If Not objWord Is Nothing Then
         objWord.Quit
         Set objWord = Nothing
     End If
     Exit Sub

RigaErrore:
     MsgBox Err.Number & vbNewLine & Err.Description
     Resume RigaChiusura

End Sub

di Vecchio Frac data: 26/04/2013 12:19:46
Ma in definitiva hai provato il codice? Funziona? Ottieni errori?
O vuoi un parere stilistico?
:)
di andre (utente non iscritto) data: 26/04/2013 12:49:55
si l'ho provato ma nn andava!! ma sono riuscito a risolvere da solo! cmq grazie mille ugualmente!! ciao ciao!!!

di andre (utente non iscritto) data: 26/04/2013 12:50:52
incollo la soluzione nel caso qualcuno abbia lo stesso problema!

ublic Sub m()

On Error GoTo RigaErrore

     Dim objWord As Object
     Dim objDoc As Object
     Dim sPath As String
     Dim sNomeFile As String
     Dim sh As Worksheet
     Dim lRiga As Long
     Dim lng As Long
     Dim controllo As Variant
     Dim controllo2 As Variant
     Dim oRng As Object
 
     Set sh = ThisWorkbook.Worksheets("Foglio1")
     sPath = "C:UsersamaistoDesktop"
     sNomeFile = "doc1.docx"
     
     With sh
     
         lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
         Set objWord = CreateObject("Word.Application")
         For lng = 2 To lRiga
         
            If Dir(sPath) <> "" Then
                 
                 Set objDoc = objWord.Documents.Open(sPath & sNomeFile)
    
                 objDoc.Bookmarks("A" & lng).Range.Text = .Range("A" & lng).Value
                 
                 'objWord.Visible = True
                 
             End If
         Next
    
    
    
         lRiga = .Range("B" & .Rows.Count).End(xlUp).Row
         For lng = 2 To lRiga
          
            If Dir(sPath) <> "" Then
                 
                 Set objDoc = objWord.Documents.Open(sPath & sNomeFile)
                 
                 Set oRng = objDoc.Content
                 oRng.Start = objDoc.Bookmarks("I" & lng).Range.End
                 oRng.End = objDoc.Bookmarks("F" & lng).Range.Start
                 
                 controllo = Range("B" & lng).Value
                 controllo2 = Range("C" & lng).Value
                 If controllo <> controllo2 Then
                    
                    oRng.Delete
                    
                 End If
                 
                 'objWord.Visible = True
                
                 
             End If
         Next
    

     objDoc.SaveAs (sPath & "Aggiornato" & ".docx")
     objDoc.Close
     Set objDoc = Nothing
     End With
     
RigaChiusura:
     If Not objWord Is Nothing Then
         objWord.Quit
         Set objWord = Nothing
     End If
     Exit Sub

RigaErrore:
     MsgBox Err.Number & vbNewLine & Err.Description
     Resume RigaChiusura

End Sub

di Vecchio Frac data: 26/04/2013 15:02:06
Bene! Se hai risolto ti chiedo di marcare la discussione come "Risolta", spuntando il relativo checkbox in una nuova risposta.
di andre (utente non iscritto) data: 26/04/2013 16:12:48
fatto

Vuoi Approfondire?