VBA复制行高?
VBA copy row height?
我有一个在 excel 2003 年制作的电子表格(另存为启用宏的 2007 .xlsm 电子表格),它使用查询从 SQL 获取数据。我已将电子表格设置为只读,这样用户就不会弄乱我的工作,并使用以下代码仅将主电子表格中的值复制到新电子表格
Sub NewWB()
Dim wbNew As Workbook
Dim wbThis As Workbook
Dim rng As Range
Dim wbName As String
Dim Pic As Picture
wbName = ThisWorkbook.Name
Set wbThis = Application.Workbooks(wbName)
Set rng = wbThis.Worksheets("Report").Range("C1:AZ65336")
Set wbNew = Workbooks.Add(xlWBATWorksheet)
Set Pic = wbThis.Worksheets("Report").Pictures("Picture 2")
With Pic
With .ShapeRange
.ScaleHeight 1#, msoScaleFromTopLeft
.ScaleWidth 1#, msoScaleFromTopLeft
End With
End With
rng.Copy
With wbNew
.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
.Worksheets(1).Range("A1").PasteSpecial Paste:=8
.Worksheets(1).Range("A1").PasteSpecial xlPasteFormats
Pic.Copy
.Worksheets(1).Paste
.SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
Format(Date, "_yyyy-mm-dd"), _
FileFormat:=xlWorkbookNormal
End With
' wbThis.Close
End Sub
解决一个小问题效果很好。它不会复制我的行高,所以我复制的徽标最终会覆盖部分数据!令我难以置信的是,有一种方法可以直接复制列,但没有任何方法可以复制行。
我需要做什么才能复制行高,我正在处理文档的前 100 行。
我做了两个新变量
Dim rngNew as Range
Dim x As Integer
并编辑了我的 "With wbNew" 部分以包含以下代码
With wbNew
.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted
.Worksheets(1).Range("A1").PasteSpecial Paste:=8 ' Paste the column widths
.Worksheets(1).Range("A1").PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc)
x = 1
For Each rngNew In .Worksheets(1).Range("A1:A100") ' Set the range in the new worbook
rngNew.EntireRow.RowHeight = wbThis.Worksheets("Report").Range("A" & CStr(x)).RowHeight 'Each row in the new workbook equals the equivilant row in the first workbook
x = x + 1
Next
Pic.Copy ' Copy the logo
.Worksheets(1).Paste ' Paste the Logo
.SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
Format(ReportDate, "_yyyy-mm-dd"), _
FileFormat:=xlWorkbookNormal ' Save the workbook as a generic .xls
End With
它比我希望的更粗糙,它使用了我从第一行开始的假设(这对我正在做的事情来说很好)但是除非有更好的答案,否则它是有效的。
我有一个在 excel 2003 年制作的电子表格(另存为启用宏的 2007 .xlsm 电子表格),它使用查询从 SQL 获取数据。我已将电子表格设置为只读,这样用户就不会弄乱我的工作,并使用以下代码仅将主电子表格中的值复制到新电子表格
Sub NewWB()
Dim wbNew As Workbook
Dim wbThis As Workbook
Dim rng As Range
Dim wbName As String
Dim Pic As Picture
wbName = ThisWorkbook.Name
Set wbThis = Application.Workbooks(wbName)
Set rng = wbThis.Worksheets("Report").Range("C1:AZ65336")
Set wbNew = Workbooks.Add(xlWBATWorksheet)
Set Pic = wbThis.Worksheets("Report").Pictures("Picture 2")
With Pic
With .ShapeRange
.ScaleHeight 1#, msoScaleFromTopLeft
.ScaleWidth 1#, msoScaleFromTopLeft
End With
End With
rng.Copy
With wbNew
.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
.Worksheets(1).Range("A1").PasteSpecial Paste:=8
.Worksheets(1).Range("A1").PasteSpecial xlPasteFormats
Pic.Copy
.Worksheets(1).Paste
.SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
Format(Date, "_yyyy-mm-dd"), _
FileFormat:=xlWorkbookNormal
End With
' wbThis.Close
End Sub
解决一个小问题效果很好。它不会复制我的行高,所以我复制的徽标最终会覆盖部分数据!令我难以置信的是,有一种方法可以直接复制列,但没有任何方法可以复制行。
我需要做什么才能复制行高,我正在处理文档的前 100 行。
我做了两个新变量
Dim rngNew as Range
Dim x As Integer
并编辑了我的 "With wbNew" 部分以包含以下代码
With wbNew
.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted
.Worksheets(1).Range("A1").PasteSpecial Paste:=8 ' Paste the column widths
.Worksheets(1).Range("A1").PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc)
x = 1
For Each rngNew In .Worksheets(1).Range("A1:A100") ' Set the range in the new worbook
rngNew.EntireRow.RowHeight = wbThis.Worksheets("Report").Range("A" & CStr(x)).RowHeight 'Each row in the new workbook equals the equivilant row in the first workbook
x = x + 1
Next
Pic.Copy ' Copy the logo
.Worksheets(1).Paste ' Paste the Logo
.SaveAs Filename:=wbThis.Path & "\" & Left(wbName, InStr(wbName, ".") - 1) & _
Format(ReportDate, "_yyyy-mm-dd"), _
FileFormat:=xlWorkbookNormal ' Save the workbook as a generic .xls
End With
它比我希望的更粗糙,它使用了我从第一行开始的假设(这对我正在做的事情来说很好)但是除非有更好的答案,否则它是有效的。