分类: ASP预览模式: 普通 | 列表

Use VBA SaveAs in Excel 2007-2016

Use VBA SaveAs in Excel 2007-2016

Information

You see a lot of old SaveAs code that does not specify the FileFormat parameter. In Excel versions before Excel 2007, code without this parameter will not cause too many problems because Excel will use the current FileFormat of the existing file and the default FileFormat for new files is a (xls) in 97-2003 because there are no other Excel file formats before Excel 2007. 

But because there are so many new file formats in Excel 2007-2016, we shouldn't use code like this that does not specify the FileFormat parameter. In Excel 2007-2016, SaveAs requires you to provide both the FileFormat parameter and the correct file extension.

For example, in Excel 2007-2016, this will fail if the ActiveWorkbook is not an xlsm file
ActiveWorkbook.SaveAs "C:\ron.xlsm"

This code will always work
ActiveWorkbook.SaveAs "C:\ron.xlsm", fileformat:=52 
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2016)


These are the main file formats in Excel 2007-2016, Note: In Excel for the Mac the values are +1

51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)

Note: I always use the FileFormat numbers instead of the defined constants in my code so that it will compile OK when I copy the code into an Excel 97-2003 workbook (For example, Excel 97-2003 won't know what the xlOpenXMLWorkbookMacroEnabled constant is).

Examples

Below are two basic code examples to copy the ActiveSheet to a new Workbook and save it in a format that matches the file extension of the parent workbook. The second example use GetSaveAsFilename to ask you for a file path/name. Example 1 you can use in Excel 97-2016 , Example 2 you can use in Excel 2000-2016.

If you run the code in Excel 2007-2016 it will look at the FileFormat of the parent workbook and save the new file in that format. Only if the parent workbook is an xlsm file and if there is no VBA code in the new workbook it will save the new file as xlsx. If the parent workbook is not an xlsx, xlsm or xls then it will be saved as xlsb.

If you always want to save in a certain format you can replace this part of the macro:

                 Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select

With one of the one liners from this list

FileExtStr = ".xlsb": FileFormatNum = 50 
FileExtStr = ".xlsx": FileFormatNum = 51
FileExtStr = ".xlsm": FileFormatNum = 52


or maybe you want to save the one worksheet workbook to csv, txt or prn.
(you can use this also if you run the code in Excel 97-2003)

FileExtStr = ".csv": FileFormatNum = 6
FileExtStr = ".txt": FileFormatNum = -4158
FileExtStr = ".prn": FileFormatNum = 36

 

Examples

Sub Copy_ActiveSheet_1()
'Working in Excel 97-2016
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
    End With

    '    'Change all cells in the worksheet to values if you want     '    With Destwb.Sheets(1).UsedRange     '        .Cells.Copy     '        .Cells.PasteSpecial xlPasteValues     '        .Cells(1).Select     '    End With     '    Application.CutCopyMode = False

    'Save the new workbook and close it
    TempFilePath = Application.DefaultFilePath & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With

    MsgBox "You can find the new file in " & TempFilePath

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub



Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2016
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)         'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _
        filefilter:="Excel Files (*.xls), *.xls", _
        Title:="This example copies the ActiveSheet to a new workbook")

        If fname <> False Then
            'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        'Give the user the choice to save in 2000-2003 format or in one of the         'new formats. Use the "Save as type" dropdown to make a choice,Default =         'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
        
        fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
            " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
            " Excel 2000-2003 Workbook (*.xls), *.xls," & _
            " Excel Binary Workbook (*.xlsb), *.xlsb", _
            FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
         'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter             'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub

 

分类:ASP | 固定链接 | 评论: 9 | 引用: 0 | 查看次数: 735

 Teleport Pro 是款优秀的网站离线浏览工具(即网站整站下载工具),Teleport Ultra是其增强版,但使用此系列软件下载的离线网页里会包含大量冗余代码(如tppabs),手动去修改工作量很大,下面介绍如何通过软件进行正则表达式批量替换冗余代码(推荐DreamWeaver的正则替换功能)。

 

清除tppabs标签:

html文件中:

查找:\btppabs="h[^"]*"

替换:(空)

css文件中的图片链接(以gif图片为例):

查找:tpa=http://[^\s]*.gif

替换:(空)

css文件中的注释:

查找:/\*tpa.*?\*/

替换:(空)

 

修复confirm链接:

查找:href=" *javascript:if\(confirm\('(htt[^"\s]*).*?"

替换:href="$1"

冗余代码示例:href="javascript:if(confirm('http://www.abcd9.com/  \n\n该文件无法用 Teleport Ultra 下载, 因为 不可用, 或放弃了下载, 或项目即将停止。  \n\n你想在服务器上打开它?'))window.location='http://www.abcd9.com/'"

示例替换后结果:href=http://www.abcd9.com/

分类:ASP | 固定链接 | 评论: 1 | 引用: 0 | 查看次数: 1751

SQL添加表字段

 通用式: alter table [表名] add [字段名] 字段属性 default 缺省值 default 是可选参数

增加字段: alter table [表名] add 字段名 smallint default 0 增加数字字段,整型,缺省值为0 
alter table [表名] add 字段名 int default 0 增加数字字段,长整型,缺省值为0
alter table [表名] add 字段名 single default 0 增加数字字段,单精度型,缺省值为0 
alter table [表名] add 字段名 double default 0 增加数字字段,双精度型,缺省值为0
alter table [表名] add 字段名 Tinyint default 0 增加数字字段,字节型,缺省值为0
 
alter table [表名] add 字段名 text [null] 增加备注型字段,[null]可选参数
alter table [表名] add 字段名 memo [null] 增加备注型字段,[null]可选参数
 
alter table [表名] add 字段名 varchar(N) [null] 增加变长文本型字段 大小 为N(1~255)
alter table [表名] add 字段名 char [null] 增加定长文本型字段 大小固定为255
 
alter table [表名] add 字段名 Datetime default 函数 增加日期型字段,其中 函数 可以是 now(),date()等,表示缺省值
(上面都是最常用的,还有其他的属性,可以参考下面的数据类型描述)
 
删除字段: alter table [表名] drop 字段名
 
修改变长文本型字段的大小:alter table [表名] alter 字段名 varchar(N)
 
删除表: drop table [表名]
分类:ASP | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1654

                             SQLServer2005如何批量修改架构名

SQLServer2005单个修改架构名

  格式:Alter SCHEMA 新构架名 TRANSFER 旧构架名.A000001

  列子:Alter SCHEMA dbo TRANSFER CH330300.A000001

SQLServer2005批量修改构架名

使用游标

第一步:执行下面语句

use Temp

go

declare @name sysname

 declare csr cursor

   for select TABLE_NAME from INFORMATION_SCHEMA.TABLES

open csr

  FETCH NEXT FROM csr INTO @name

while (@@FETCH_STATUS=0)

BEGIN

SET @name='原构架名.' + @name

print 'Alter SCHEMA 新构架名 TRANSFER ' + @name

fetch next from csr into @name

END

CLOSE csr

DEALLOCATE csr

第二步:把第一步执行的结果,拷贝到查询窗口进行执行。

图解

第一步:如下图

第二步:如下图

到此结束!!!

分类:ASP | 固定链接 | 评论: 133 | 引用: 0 | 查看次数: 3595

asp 二维数组排序/一维数组排序

Function Sort(ary)
   Dim KeepChecking,I,FirstValue,SecondValue
   IF Not IsArray(ary) Then Exit Function
   KeepChecking = True
   Do Until KeepChecking = False
     KeepChecking = False
     For I = 0 To UBound(ary)
       IF I = UBound(ary) Then Exit For
       IF ary(I) > ary(I + 1) Then
         FirstValue = ary(I)
         SecondValue = ary(I+1)
         ary(I) = SecondValue
         ary(I+1) = FirstValue
         KeepChecking = True
       End IF
     Next
   Loop
   Sort = ary
End Function
 
二维:
 
<%
 
Function Sort(arr,u)
   Dim UNum1,UNum2
   Dim UTrue,A1,A2
   IF Not IsArray(arr) Then Exit Function
   IF Not IsNumeric(u) Then u = 0
   UNum1 = UBound(arr)
   UNum2 = UBound(arr,2)
   ReDim Arr1(UNum1),Arr2(UNum1),Arr3(UNum1,UNum2)
   For i = 0 To UNum1
     Arr1(i) = arr(i,u)
     Arr2(i) = i
   Next
   UTrue = True
   Do Until Not UTrue
     UTrue = False
     For i = 0 To UNum1
       IF i = UNum1 Then Exit For
       IF Arr1(i) > Arr1(i+1) Then
         A1 = Arr1(i):Arr1(i) = Arr1(i+1):Arr1(i+1) = A1
         A2 = Arr2(i):Arr2(i) = Arr2(i+1):Arr2(i+1) = A2
         UTrue = True
       End IF
     Next
   Loop
   For i = 0 To UNum2
     For n = 0 To UNum1
       Arr3(n,i) = arr(Arr2(n),i)
     Next
   Next
   Sort = Arr3
End Function
 
'应用实例
dim Myarray(15,9)
Randomize
response.write "<table cellSpacing=0 cellPadding=4 border=1>"
for i = 0 to UBound(Myarray,2)
   response.write "<tr>"
   for n = 0 to UBound(Myarray)
     Myarray(n,i) = fix(n*Rnd * 100 + 50 * Rnd * 2)
     response.write "<td width=35>" & Myarray(n,i) & "</td>"
   next
   response.write "</tr>" & vbnewline
next
response.write "</table><br>"
 
v = Sort(Myarray,0)
response.write "<table cellSpacing=0 cellPadding=4 border=1>"
for i = 0 to UBound(v,2)
   response.write "<tr>"
   for n = 0 to UBound(v)
     response.write "<td width=35>" & v(n,i) & "</td>"
   next
   response.write "</tr>" & vbnewline
next
response.write "</table>"
 
%>
 
<%
Function SortRev(ary) '一维的反向排序,移山补充。
   Dim KeepChecking,I,FirstValue,SecondValue
   IF Not IsArray(ary) Then Exit Function
   KeepChecking = True
   Do Until KeepChecking = False
     KeepChecking = False
     For I = 0 To UBound(ary)
       IF I = UBound(ary) Then Exit For
       IF ary(I) < ary(I + 1) Then
         FirstValue = ary(I)
         SecondValue = ary(I+1)
         ary(I) = SecondValue
         ary(I+1) = FirstValue
         KeepChecking = True
       End IF
     Next
   Loop
   SortRev = ary
End Function
dim myarr(4)
myarr(0) = 68
myarr(1) = 98
myarr(2) = 68
myarr(3) = 68
myarr(4) = 45
newarr = SortRev(myarr)
for i = 0 to ubound(newarr)
w newarr(i)
%>
分类:ASP | 固定链接 | 评论: 880 | 引用: 0 | 查看次数: 15395
有一客户使用风讯内容管理系统 FoosunCMS V5.0做网站,后台发布的时候会被IIS防火墙(智创IIS防火墙、网站安全狗等)拦截。

为了彻底解决此问题,今晚检查了下风讯的程序,发现是由于admin/PublicSite/Public_Refresh.asp这个文件在执行发布的时候会写入一些敏感关键词到cookies,被防火墙视为Cookies注入而拦截。将此文件内用于发布的cookies全部改用session后程序正常。

查看更多...

分类:ASP | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1754

js实现checkbox全选,反选,全不选

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">  
<html xmlns="http://www.w3.org/1999/xhtml">  
<head>  
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312" />  
    <title>js实现checkbox全选,反选,全不选</title>  

查看更多...

分类:ASP | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1689

火狐与IE兼容性总结

兼容性一直都是个令人头痛的问题,下面简单总结火狐与IE的兼容性问题。
1. 超链接访问过后hover样式就不出现的问题
    被点击访问过的超链接样式不在具有hover和active了,很多人应该都遇到过这个问题,解决方法是改变CSS属性的排列顺序: L-V-H-A
   Code:
   <style type="text/css">

查看更多...

分类:ASP | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1827

三步教你学会ajax开发应用

ajax在很多程序员的眼里是一个很复杂或陌生的字眼,其实, AX并不复杂,自从AJAX技术出来后,天花乱坠的框架纷纷出台,搞得技术开发人员无从下手,baidu google里也有很多例子,大都是非常复杂。
  其实就web开发而言,AJAX技术只是一个配合,完全没有必要本末倒置,是一种页面优化的技术,也就是说,如何去优化我们的web页面才是AJAX的重头戏。下面我举个很简单的例子,可以满足大部分的业务需求。(当然,如果是很专业的页面要求,可以去参考那些复杂的框架)
  第一步:写一个后台的“接口”,这个可以用任何语言来实现,只要能返回http报文就可以了,我这里以webwork后台代码举个例子
public String hotWeek() throws Exception{
        HttpServletResponse response = ServletActionContext.getResponse();

查看更多...

分类:ASP | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1766

jQuery技巧大全

一、简介

1.1、概述
随着WEB2.0及ajax思想在互联网上的快速发展传播,陆续出现了一些优秀的Js框架,其中比较著名的有Prototype、YUI、jQuery、mootools、Bindows以及国内的JSVM框架等,通过将这些JS框架应用到我们的项目中能够使程序员从设计和书写繁杂的JS应用中解脱出来,将关注点转向功能需求而非实现细节上,从而提高项目的开发速度。
jQuery是继prototype之后的又一个优秀的Javascript框架。它是由 John Resig 于 2006 年初创建的,它有助于简化 Javascript™ 以及Ajax 编程。有人使用这样的一比喻来比较prototype和jQuery:prototype就像Java,而jQuery就像ruby. 它是一个简洁快速灵活的Javascript框架,它能让你在你的网页上简单的操作文档、处理事件、实现特效并为Web页面添加Ajax交互。

查看更多...

分类:ASP | 固定链接 | 评论: 297 | 引用: 0 | 查看次数: 4835