Bereich für mehrere Zellen arbeiten nicht in vba

Question

ich mehrere Zellen gleichzeitig zuzugreifen versuche wie folgt:

Set rng = Worksheets("dts").Range("A3,C3:D3,G8,I8:J8,G9,I9:J9,G21,I21:J21,G30,I30:J30,G39,I39:J39") 

Wenn ich wie folgt rangetoHTML:

rangetoHTML(rng) 

Function rangetoHTML(rng As Range) 
' Changed by Ron de Bruin 28-Oct-2006 
' Working in Office 2000-2013 
    Dim fso As Object 
    Dim ts As Object 
    Dim TempFile As String 
    Dim TempWB As Workbook 

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

    'Copy the range and create a new workbook to past the data in 
    rng.Copy 
    Set TempWB = Workbooks.Add(1) 
    With TempWB.Sheets(1) 
     .Cells(1).PasteSpecial Paste:=8 
     .Cells(1).PasteSpecial xlPasteValues, , False, False 
     .Cells(1).PasteSpecial xlPasteFormats, , False, False 
     .Cells(1).Select 
     Application.CutCopyMode = False 
     On Error Resume Next 
     .DrawingObjects.Visible = True 
     .DrawingObjects.Delete 
     On Error GoTo 0 
    End With 

    'Publish the sheet to a htm file 
    With TempWB.PublishObjects.Add(_ 
     SourceType:=xlSourceRange, _ 
     Filename:=TempFile, _ 
     Sheet:=TempWB.Sheets(1).Name, _ 
     Source:=TempWB.Sheets(1).UsedRange.Address, _ 
     HtmlType:=xlHtmlStatic) 
     .Publish (True) 
    End With 

    'Read all data from the htm file into RangetoHTML 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
    rangetoHTML = ts.readall 
    ts.Close 
    rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _ 
          "align=left x:publishsource=") 

    'Close TempWB 
    TempWB.Close savechanges:=False 

    'Delete the htm file we used in this function 
    Kill TempFile 

    Set ts = Nothing 
    Set fso = Nothing 
    Set TempWB = Nothing 

End Function 

Es überspringt die Linie RNG .Kopieren. Nicht sicher warum. Brauchen Sie eine Anleitung dazu.

Answer 1

Sie haben über alle Entfernungszellen in einer Schleife

aber Areas Eigenschaft Range Objekt kopiert werden könnte helfen, und Sie können auch eine tempWb Einstellung zu vermeiden, während es gerade „on the fly“ zu schaffen und entlassen, nachdem es nicht ist mehr

nützliche

wie folgt:

Function rangetoHTML(rng As Range) 
' Changed by Ron de Bruin 28-Oct-2006 
' Working in Office 2000-2013 
    Dim fso As Object 
    Dim ts As Object 
    Dim TempFile As String 
    Dim TempWB As Workbook 
    Dim area As Range, cellToOffsetFrom As Range 

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

    'Copy the range and create a new workbook to past the data in 
    With Workbooks.Add(1) '<--| create temp wb 
     With .Sheets(1) 
      Set cellToOffsetFrom = rng.Areas(1).Cells(1, 1) '<--| get the 'rng' upleftmost cell as reference for offsetting all other ones 
      For Each area In rng.Areas '<--| loop through 'Areas' 
       area.Copy '<--| copy single 'Area', i.e. contiguous cells 
       With .Cells(area.Cells(1, 1).Row - cellToOffsetFrom.Row + 1, area.Cells(1, 1).Column - cellToOffsetFrom.Column + 1) '<--| reference proper target cell to paste values 
        .PasteSpecial Paste:=8 
        .PasteSpecial xlPasteValues, , False, False 
        .PasteSpecial xlPasteFormats, , False, False 
       End With 
       Application.CutCopyMode = False 
      Next 
      On Error Resume Next 
      .DrawingObjects.Visible = True 
      .DrawingObjects.Delete 
      On Error GoTo 0 
     End With 

     With .PublishObjects.Add(_ 
      SourceType:=xlSourceRange, _ 
      Filename:=TempFile, _ 
      Sheet:=.Sheets(1).Name, _ 
      Source:=.Sheets(1).UsedRange.Address, _ 
      HtmlType:=xlHtmlStatic) 
      .Publish (True) 
     End With 
    End With 
    ActiveWorkbook.Close savechanges:=False '<--|'Close TempWB 

    'Read all data from the htm file into RangetoHTML 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
    rangetoHTML = ts.readall 
    ts.Close 
    rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _ 
          "align=left x:publishsource=") 

    'Delete the htm file we used in this function 
    Kill TempFile 

    Set ts = Nothing 
    Set fso = Nothing 

End Function