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:
Classe XLAddIn: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
Main.Bas: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
in questo modo, tu andrai a lavorare solo sul cls XLAddIn e il connect.dsr non lo scasini + di tanto...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
fammi sapere..

Rispondi quotando