excel2007技巧之九.pdf

《excel2007技巧之九.pdf》由会员分享，可在线阅读，更多相关《excel2007技巧之九.pdf（50页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、ExcelExcelVBAExcelExcelExcelExcelOfficeInternetXMLExcelVBAVBA102Excel1ExcelB31.2.3.1.2.3.4.103Chapter 9Excel2C21.2.3.1.3.4.1043Excel2.105Chapter 9Excel4ExcelHYPERLINKC3=HYPERLINK(!F3)EnterC3C12D3=HYPERLINK(!C3)EnterD3D12106E3=SUM(C3+D3)EnterE3E12HYPERLINKInternetHYPERLINKMicrosoft Excellink_location

2、HYPERLINK(link_location,friendly_name)Link_locationFriendly_name5107Chapter 9ExcelCtrl6C21.2.3.1.2.3.4.1087ExcelA3:E3Ctrl+CB41.2.1.2.1.109Chapter 9Excel8ExcelCtrl+TSub()Macro :Ctrl+t Range(B3).Select Selection.Hyperlinks.Delete 1.2.1.2.1.2.110End Sub Range(B3).SelectRange(B3:E4).SelectExcelCtrl+T9Ex

3、celEnterEnterCtrl+ZAlt+F8SubEnd SubCells.Hyperlinks.DeleteExcel10ExcelSheet2Sheet3.Sheet1SheetA1Sheet2111Chapter 9ExcelA2Sheet3A1Sheet2A2Sheet3A1Sheet2A2Sheet311Visual BasicVisual BasicAlt+F11Microsoft Visual Basic|Sub()Dim Pt As Range Dim i As Integer With Sheet1 Set Pt=.Range(a1)For i=2 To ThisWor

4、kbook.Worksheets.Count .Hyperlinks.Add Anchor:=Pt,Address:=,SubAddress:=Worksheets(i).Name&!A1 Set Pt=Pt.Offset(1,0)Next i End With End Sub Microsoft Visual BasicExcelAlt+F8Sheet1111Chapter 9Excel1WordExcelWordExcelExcelWordWordExcelMicrosoft Office WordWordWordExcelWordExcelHTMLWordExcel2ExcelWordW

5、ordExcelExcelWord-ExcelExcelWordExcel112ExcelCtrl+CWordWordExcelWordWord1.113Chapter 9ExcelExcelWord3TXTExcelTXTExcelExcelTXT1.2.114TXTExcelTXTExcel4ExcelTXTTXTExcelExcelExcelOffice*.prn;*.txt;*.csv115Chapter 9Excel5ExcelExcelExcelWebExcel1.1166InternetExcel117Chapter 9Excel7ExcelAccessExcelAccess-E

6、xcel-ExcelCtrl+CAccessExcelAccessAccessExcelAccessAccesssExcel-Excel1.2.118-Excel-Excel-ExcelExcel1.2.1.2.2.119Chapter 9ExcelAccessExcelExcelAccesssExcel-ExcelExcel-ExcelAccess1.120-ExcelExcel8AccessExcelAccess 2007Excel-ExcelAccessAccessExcel121Chapter 9ExcelAccessCtrl+CExcelAccessExcelAccessAccess

7、ExcelAccessExcelExcelExcel1.2.122AccessExcelAccessExcelAccessOKOutlook123Chapter 9Excel9ExcelOffice|*.txtMicrosoft Offiice ExcelMicrosoft Offiice ExcelExcelExcel1 0ExcelExcelExcel1.2.124ExcelExcelOffice|*.htm;*.htmlMicrosoft Offiice Excel.filesExcelExcelOffice|*.htm;*.html1.2.125Chapter 9ExcelWebHTT

8、PFTPExcel1 1XM LExcelExcelXMLExcelXMLMicrosoft Offiice Excel1.2.126XMLExcel125Chapter 9ExcelVBA1VBAHello WorldVBAHello WorldAlt+F11VBA126Sheet1(Sheet1)Public Sub ExcelbaSub1()Dim TStr As String TStr=Hello World!Application.ActiveSheet.Range(A1).Value=TStr Debug.Print TStr MsgBox TStr,End Sub VBAShee

9、t1.Excelba Sub12Atl+F11VBA|2.1.2.127Chapter 9Excel1Function Age(BirthDate As Date)Select Case Month(Date)Case Is=Day(BirthDate)Then Age=Year(Date)-Year(BirthDate)+1 Else Age=Year(Date)-Year(BirthDate)End If Case Is Month(BirthDate)Age=Year(Date)-Year(BirthDate)+1 End Select End Function VBAA11984-12

10、-10B1B1=age(A1)EnterFunction Age(BirthDate As Date)Age=Int(Date-BirthDate)/365.25)+1 End Function 3VBAWindows DesktopMyDocumentsVBAAtl+F11VBAA1#VALUE!128Sheet1(Sheet1)Option Explicit Sub GetMyDocumentsPath()Dim WSHShell As Object Set WSHShell=CreateObject(Wscript.Shell)MsgBox MyDocuments&WSHShell.Sp

11、ecialFolders(MyDocuments)Set WSHShell=Nothing End Sub VBASheet1.List FormulasMyDocumentsAllUsersDesktop AllUsersStartMenu AllUsersPrograms AllUsersStartup Desktop Favorites Fonts MyDocumentsMyDocuments1.2.1.2.129Chapter 9ExcelMyDocuments NetHood PrintHood Programs Recent SendTo StartMenu Startup Tem

12、plates 4Shift|Shift|1.2.1.2.1.2.1305VBAExcelVBAA1:A6Atl+F11VBASheet1(Sheet1)Sub ConvertToEmail()Dim convertRng As Range Set convertRng=Range(F2:F18)Dim rng As Range For Each rng In convertRng If rng.Value Then ActiveSheet.Hyperlinks.Add rng,mailto:&rng.Value End If Next rng End Sub VBACtrl+X1.2.1.1.

13、2.2.131Chapter 9ExcelSheet1.ConvertTo Email6VBAExcel VBAAtl+F11VBA|Sub Remove_WorkSheet_Password()Dim i As Integer,j As Integer,k As Integer Dim l As Integer,m As Integer,n As Integer Dim i1 As Integer,i2 As Integer,i3 As Integer Dim i4 As Integer,i5 As Integer,i6 As Integer On Error Resume Next If

14、ActiveSheet.ProtectContents=False Then MsgBox Exit Sub End If For i=65 To 66:For j=65 To 66:For k=1.1.13265 To 66 For l=65 To 66:For m=65 To 66:For i1=65 To 66 For i2=65 To 66:For i3=65 To 66:For i4=65 To 66 For i5=65 To 66:For i6=65 To 66:For n=32 To 126 ActiveSheet.Unprotect Chr(i)&Chr(j)&Chr(k)&_

15、 Chr(l)&Chr(m)&Chr(i1)&Chr(i2)&Chr(i3)&_ Chr(i4)&Chr(i5)&Chr(i6)&Chr(n)If ActiveSheet.ProtectContents=False Then MsgBox Exit Sub End If Next:Next:Next:Next:Next:Next Next:Next:Next:Next:Next:Next End Sub VBARemove_Work Sheet_Password7VBAVBAVBAA1:A101-101.2.133Chapter 9ExcelAtl+F11VBASheet1(Sheet1)Su

16、b RndNumberNoRepeat()Dim RndNumber,TempArray(9),i As Integer Randomize(Timer)For i=0 To 9 1100TempArray(i)=i Next i For i=9 To 0 Step-1 RndNumber=Int(i*Rnd)A1:A100Cells(10-i,1)=TempArray(RndNumber)+1 TempArray(RndNumber)=Temp Array(i)Next i End Sub VBA|Sheet1.RndNumber NoRepeat2.1.1.2.1348WordVBAWor

17、dAtl+F11VBA|VBAprojectMicrosoft Word 11.0 Object LibraryVBA|Public Sub PrintFormulasToWord()Dim Cnt As String Dim C As Range Dim WordObj As Word.Application Dim HasArr As Boolean On Error Resume Next Err.Number=0 Set WordObj=GetObject(,Word.Application)If Err.Number=429 Then Set WordObj=CreateObject

18、(Word.Application)Err.Number=0 End If WordObj.Visible=True WordObj.Documents.Add With WordObj.Selection.Font.Name=Courier New.TypeText +Active Sheet.Name.TypeParagraph.TypeText +Selection.Cells(1,1).Address(False,False,xlA1)_&to&Selection.Cells(Selection.Rows.Count,_ Selection.Columns.Count).Address

19、(False,False,xlA1).TypeParagraph.TypeParagraph 1.135Chapter 9ExcelEnd With For Each C In Selection HasArr=C.HasArray Cnt=C.Formula If HasArr Then Cnt=+Cnt+End If If Cnt Then With WordObj.Selection.Font.Bold=True.TypeText C.Address(False,False,xlA1)&:.Font.Bold=False.TypeText Cnt.TypeParagraph.TypePa

20、ragraph End With End If Next C MsgBox Word,Word End Sub VBA|/F5Word1369ExcelExcelExcelVBAAtl+F11VBAThisWork bookPrivate Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean,Cancel As Boolean)ExcelXlsFilePath=D:BackupXlsFilePath=E:If ThisWorkbook.Path=XlsFilePath Then ExcelFilePath=BackupXlsFilePath Els

21、e ExcelFilePath=XlsFilePath End If Response=MsgBox(Excel&vbCr&ExcelFilePath,vbYesNo,)If Response=vbYes Then ExcelThisWorkbook.SaveCopyAs Filename:=ExcelFilePath&ThisWorkbook.Name End If End Sub XlsFilePath=D:Backup XlsFilePath=E:ExcelD:E:1.2.3.2006ExcelCtrl+SExcel10Excel1.2.137Chapter 9ExcelVBAAtl+F

22、11VBA|ThisWorkbookPrivate Sub Workbook_Open()Sheet3.Activate End Sub ExcelSheet3Sheet3Sheet3ExcelSheet3Private Sub Workbook_Open()Sheets().Select End Sub 1 1WordExcelWordAtl+F11VBA138Sheets1(Sheets1)Public Sub PrintCellComments()Dim Cmt As String Dim C As Range Dim I As Integer Dim WordObj As Object

23、 Dim ws As Worksheet Dim PrintValue As Boolean Dim res As Integer On Error Resume Next Err.Number=0 res=MsgBox(Word,_ vbYesNoCancel+vbQuestion,)Select Case res Case vbCancel Exit Sub Case vbYes PrintValue=True Case Else PrintValue=False End Select Set WordObj=GetObject(,Word.Application)If Err.Numbe

24、r=429 Then Set WordObj=CreateObject(Word.Application)Err.Number=0 End If WordObj.Visible=True WordObj.Documents.Add With WordObj.Selection.TypeText Text:=+ActiveWorkbook.Name.TypeParagraph.TypeText Text:=+Format(Now(),yyyy)+Format(Now(),m)+Format(Now(),d)+.TypeParagraph.TypeParagraph End With For Ea

25、ch ws In Worksheets For I=1 To ws.Comments.Count Set C=ws.Comments(I).Parent Cmt=ws.Comments(I).Text With WordObj.Selection.TypeText Text:=+_ C.Address(False,False,xlA1)+ws.Name If PrintValue=True Then.TypeText Text:=+Format(C.Value)End If.TypeParagraph .TypeText Text:=Cmt .TypeParagraph .TypeParagr

26、aph End With Next I Next ws Set WordObj=Nothing MsgBox Word,vbInformation,_ End Sub 139Chapter 9ExcelVBASheet1.PrintCell Comments1 2VBAoffice Excel1.1.2.1.2.140ExcelExcelAtl+F11VBASheet1Option Explicit Private Sub CmdRotation_Click()CmdRotation.Enabled=False basSnow.Rotation CmdRotation.Enabled=True

27、 End Sub|Sheet1()basSnowbasSnowOption Explicit Public Sub Rotation()Dim lStep As Long Dim lWaiting As Long Dim sMessage As String *Dim sSource As String On Error GoTo Err_Handler For lStep=1 To 200 ActiveSheet.Shapes(xh).Select Selection.ShapeRange.IncrementRotation 10 ActiveSheet.Shapes(hh).Select

28、Selection.ShapeRange.IncrementRotation-10 DoEvents For lWaiting=1 To 500000 Next Next 1.2.3.1.2.2.1.141Chapter 9ExcelF22.Select Exit_Label:On Error GoTo 0 Exit Sub Err_Handler:sMessage=&vbCrLf _&Err.Description *Call MsgBox(_ Prompt:=sMessage,_ Buttons:=vbExclamation)GoTo Exit_Label End Sub VBAxhhh1

29、Rotation11.2.1.2.1.2.1.2.1421 3VBAExcelVBAAtl+F11VBA|1Sub()UserForm1.Show End Sub|UserForm1Private Sub ComboBox1_Change()Dim ITM As ListItem ListView1.ColumnHeaders.Clear ListView1.ListItems.Clear ListView1.ColumnHeaders.Add 1,ListView1.Width/4 ListView1.ColumnHeaders.Add 2,ListView1.Width/4,lvwColu

30、mnCenter ListView1.ColumnHeaders.Add 3,ListView1.Width/4,lvwColumnCenter ListView1.ColumnHeaders.Add 4,ListView1.Width/4,lvwColumnCenter ListView1.View=lvwReport ListView1.Gridlines=True For i=2 To A65536.End(xlUp).Row If Cells(i,1)=ComboBox1.Text Then Set ITM=ListView1.ListItems.Add()ITM.Text=Cells

31、(i,1)1.2.1.3.2.143Chapter 9ExcelITM.SubItems(1)=Cells(i,2)ITM.SubItems(2)=Cells(i,3)ITM.SubItems(3)=Cells(i,4)End If Next i End Sub Private Sub CommandButton1_Click()Dim i As Integer For i=Me.ListView1.ListItems.Count To 1 Step-1 If Me.ListView1.ListItems(i).Selected Then Me.ListView1.ListItems.Remo

32、ve i End If Next i End Sub Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)End Sub Private Sub UserForm_Initialize()Dim i,J For i=2 To Sheets(SHEET1).A65536.End(xlUp).Row For J=0 To ComboBox1.ListCount-1 If Cells(i,1)=ComboBox1.List(J)Then GoTo 100 Next J ComboBox1.AddItem Cells(i,1)100:Next

33、 i ListView1.FullRowSelect=True ListView1.MultiSelect=True End Sub VBAExcel11UserForm11.2.144Microsoft ListView Controlversion 6.014VBAAtl+F11VBA|12.1.2.1.2.1.2.1.2.145Chapter 9ExcelSub()UserForm1.Show End Sub|UserForm1ImageList1ImagesInsert PictureSelect picture1.2.3.1.2.1.2.1.2.146Private Sub User

34、Form_Initialize()Dim Nodx As Node TreeView1.ImageList=ImageList1 Set Nodx=TreeView1.Nodes.Add(,1)For X=2 To Range(B65536).End(xlUp).Row C1=Cells(X,1)C2=Cells(X,2)If Len(Cells(X,2)=1 Then Set Nodx=TreeView1.Nodes.Add(,tvwChild,A&C2,C1&(&C2&),2)ElseIf Len(Cells(X,2)=3 Then Set Nodx=TreeView1.Nodes.Add

35、(A&Left(C2,1),tvwChild,A&C2,C1&(&C2&),3)ElseIf Len(Cells(X,2)=6 Then Set Nodx=TreeView1.Nodes.Add(A&Left(C2,3),tvwChild,A&C2,C1&(&C2&),4)End If Next End Sub VBAExcel11UserForm1.1.2.3.4.147Chapter 9Excel15/VBA#Atl+F11VBASheet1(Sheet1)Sub()(),Dim TRan As Range,FirstAddress As String,FindStr As String,

36、i,j,k,l FindStr=#With Selection Set TRan=.Find(FindStr,LookIn:=xlValues)If Not TRan Is Nothing Then FirstAddress=TRan.Address Do i=(Len(TRan.Value)-Len(Worksheet Function.Substitute(TRan.Value,FindStr,)/Len(FindStr)k=1 For j=1 To i l=WorksheetFunction.Find(FindStr,TRan.Value,k)TRan.Characters(Start:=l,Length:=Len(FindStr).Font.Superscript=True k=l+Len(FindStr)Next Set TRan=.FindNext(TRan)Loop While Not TRan Is Nothing And TRan.Address FirstAddress End If End With End Sub VBA2.1.