[VB6] Sostituzione di testo in fogli Excel aperti

**MrNik** · 27-11-2007, 14:38

Salve a tutti.. ho qualche problemino con questo codice in un addin Com che stò scrivendo, in teoria stò cercando di sostituire un testo in tutti i fogli di excel del workbook aperto :

codice:

    Dim sh As Worksheet  
    Dim sWhat, sReplace as string

           sWaht = "prova"
           sReplace = "Prova Sostituita"

                For Each sh In application.ActiveWorkbook.Worksheets
                If sh.Name <> "Protetto" Then

                    On Local Error Resume Next
                    sh.Select
                    
                    application.Selection.Replace What:=sWhat, _
                                                           Replacement:=sReplace, _
                                                           LookAt:=1, _
                                                           SearchOrder:=1, _
                                                           MatchCase:=False, _
                                                           SearchFormat:=False, _
                                                           ReplaceFormat:=False
                End If

                Next

Quando lo eseguo (a parte excel che mi avvisa che in alcuni casi stò lavorando su un foglio vuoto) mi dà errore su 'sh.select' e mi sembra che non sostituisca nulla

non riesco a trovare niente di utilie sul web poichè fanno riferimento a macro in excel e sembra essere differente come metodo

**andreaciao_22** · 29-11-2007, 12:41

x usare la select in un foglio, il foglio deve essere attivato tramite il metodo activate...

se nn lo vuoi attivare devi fare una roba tipo questa

codice:

dim trg as Range
set trg = application.range(sh.cells(1, 1), sh.cells(65536, 255))
trg.Replace What:=sWhat, Replacement:=sReplace, LookAt:=1, SearchOrder:=1, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
set trg =nothing

fammi sapere se ti dà problemi

**andreaciao_22** · 29-11-2007, 12:47

scusa... dimenticanza mia...

e poi non è sh.select ma semmai sh.cells.select... x attivare o selezionare un worksheet si usa sh.activate

comunque io opterei per la seconda soluzione, perchè così l'utente non vede il cambio di foglio...

**MrNik** · 29-11-2007, 19:41

Devo sostituirlo al posto di application.Selection.Replace giusto?

Non sostituisce nulla.. in piu' su excel mi appare un messaggio che la ricerca non ha trovato nulla.. su word l'ho fatto ma è molto diverso qui su excel sembra cambi la sintassi...

Ho notato che il valore c'è ma sembra non riconoscerlo

Esempio se in una cella scrivo 'qui scrivo albero perchè devo cercare' e vado a sostituire albero con faggio mi dice che non trova nulla :berto: ma anche facendolo da excel dice la stessa cosa.. dov'è il problema? :master:

**andreaciao_22** · 30-11-2007, 10:08

prova questa:

codice:

Sub SostituzioneStringa()
    Dim sh As Worksheet, trg As Range, CountBlank As Double
    Dim sWhat As String, sReplace As String
    Cells(1, 1).FormulaR1C1 = "qui scrivo albero perché devo sostuituirlo"
    sWhat = "albero"
    sReplace = "faggio"
    For Each sh In Application.ActiveWorkbook.Worksheets
        If sh.Name <> "Protetto" Then
            On Local Error Resume Next
            Set trg = sh.Range("A1:IV65536")
            CountBlank = Application.WorksheetFunction.CountBlank(trg)
            If CountBlank < 16777216 Then
                trg.Replace What:=sWhat, Replacement:=sReplace, LookAt:=2, SearchOrder:=1, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            End If
            Set trg = Nothing
        End If
    Next
End Sub

l'ho testata e funziona su excel 2002

secondo me era il valore di LookAt che sbagliavi a passargli alla funzione Replace.... infatti:

1 - gli si dice a excel che tutta nella cella deve esserci quel valore esatto;
2 - gli si dice che excel di guardare la cella, se una parte di essa contiene il valore lo sostituisce...

fammi sapere

**MrNik** · 30-11-2007, 12:21

allora molto strano... se lascio application non mi fà nulla..

se invece prima dichiaro una variabile e nella connect dell'addin inserisco :

miavariabile = application

e poi uso quella allora me lo sostituisce (come se application fosse nullo)..

solo che se devo sostituire una cosa e non la trova mi da quell'odioso messaggio di excel che non trova nulla.. cosi se devo sostituire due parole se non le trova mi dice non trovato

nn c'è un modo per disabilitarlo?

comunque funziona per ora anche se con il messaggio odioso, grazie

**andreaciao_22** · 30-11-2007, 13:46

fammi vedere il codice attuale... magari c'è qualcosa che mi sfugge riguardo al messaggio che ti esce...

**MrNik** · 30-11-2007, 19:45

Allora faccio un riepilogo :

File Connect.dsr

codice:

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)

 Set mVarExcelApplication = Application

File mMain.bas (manca una parte dedicata alla connection aperta in un altro modulo che non metto perchè non ci interessa per la soluzione)

codice:

Option Explicit

Public mVarExcelApplication As Excel.Application

Public Sub Elabora()
Dim sSql As String
Dim ObjRs As ADODB.Recordset

Dim sh As Worksheet
Dim trg As Range
Dim CountBlank As Double
Dim sWhat$, sReplace$

oSql = "select * from tmpCampiReplace"
    
Set ObjRs = New ADODB.Recordset
ObjRs.Open oSql, CONN_SQL

If ObjRs.bof then
    'do nothing
else
Do Until ObjRs.EOF                
                sWhat = ObjRs("field_text")
                sReplace = ObjRs("field_replace")
                
                If Len(Trim(sReplace)) < 1 Then
                    sReplace = "'"
                End If
                    
               On Local Error Resume Next
               For Each sh In mVarExcelApplication.ActiveWorkbook.Worksheets
                    If sh.Name <> "Protetto" Then
                        On Local Error Resume Next
                        Set trg = sh.Range("A1:IV65536")
                        CountBlank = mVarExcelApplication.WorksheetFunction.CountBlank(trg)
                        If CountBlank < 16777216 Then
                            trg.Replace What:=sWhat, Replacement:=sReplace, LookAt:=2, SearchOrder:=1, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                        End If
                        Set trg = Nothing
                    End If
                Next
               
                
                ObjRs.MoveNext
            Loop
end if

ObjRs.Close
Set ObjRs = Nothing
End Sub

**andreaciao_22** · 03-12-2007, 10:47

Quale versione di excel stai usando o useranno i tuoi utenti?

**andreaciao_22** · 03-12-2007, 11:10

a me funziona...

prova a fare il debug e a vedere se CountBlank non sia = 0 ...

cmq io mi farei una classe a parte... non incasinare il connect... nel senso:

Connect.dsr:

codice:

Option Explicit
'********************************************************************
Private gBaseClass As New XLAddIn

Private Sub AddinInstance_OnAddInsUpdate(custom() As Variant)
End Sub

Private Sub AddinInstance_OnBeginShutdown(custom() As Variant)
End Sub

Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
   ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
   ByVal AddInInst As Object, custom() As Variant)
    On Error Resume Next
    'Evaluate ConnectMode
    Select Case ConnectMode
        Case ext_cm_Startup
        Case ext_cm_AfterStartup
        Case ext_cm_CommandLine
        Case ext_cm_Startup
    End Select
    If Application.Workbooks.Count = 0 Then
        Exit Sub
    End If
    gBaseClass.InitHandler Application, AddInInst.ProgId
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode _
   As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
    gBaseClass.UnInitHandler
    If RemoveMode = ext_dm_UserClosed Then
    Else
        'Host shutdown
    End If
    Set gBaseClass = Nothing
End Sub

Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
End Sub

Classe XLAddIn:

codice:

Option Explicit
Private WithEvents objExcel As Excel.Application
gstrProgID As String
Friend Sub InitHandler(XLApp As Excel.Application, strProgID As String)
    Set objExcel = XLApp
    Set gXLApp = XLApp
    gstrProgID = strProgID
    Call Elabora
End Sub

Friend Sub UnInitHandler()
    Set gXLApp = Nothing
    Set objExcel = Nothing
End Sub

Main.Bas:

codice:

Option Explicit

Public gXLApp As Excel.Application

Public Sub Elabora()
Dim sSql As String
Dim ObjRs As ADODB.Recordset

Dim sh As Worksheet
Dim trg As Range
Dim CountBlank As Double
Dim sWhat$, sReplace$

oSql = "select * from tmpCampiReplace"
    
Set ObjRs = New ADODB.Recordset
ObjRs.Open oSql, CONN_SQL

If ObjRs.bof then
    'do nothing
else
Do Until ObjRs.EOF                
                sWhat = ObjRs("field_text")
                sReplace = ObjRs("field_replace")
                
                If Len(Trim(sReplace)) < 1 Then
                    sReplace = "'"
                End If
                    
               On Local Error Resume Next
               For Each sh In mVarExcelApplication.ActiveWorkbook.Worksheets
                    If sh.Name <> "Protetto" Then
                        On Local Error Resume Next
                        Set trg = sh.Range("A1:IV65536")
                        CountBlank = mVarExcelApplication.WorksheetFunction.CountBlank(trg)
                        If CountBlank < 16777216 Then
                            trg.Replace What:=sWhat, Replacement:=sReplace, LookAt:=2, SearchOrder:=1, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                        End If
                        Set trg = Nothing
                    End If
                Next
               
                
                ObjRs.MoveNext
            Loop
     end if
ObjRs.Close
Set ObjRs = Nothing
End Sub

in questo modo, tu andrai a lavorare solo sul cls XLAddIn e il connect.dsr non lo scasini + di tanto...

fammi sapere..

Discussione: [VB6] Sostituzione di testo in fogli Excel aperti

Strumenti discussione

Ricerca discussione

Visualizza

[VB6] + [Excel]

Permessi di invio