Public Sub excelSample()
Dim xlApp As Object 'Excelアプリ'
Dim xlBook As Object 'Excelブック'
Dim xlSheet As Object 'Excelシート'
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("C:\Users\xxxxxxx\Desktop\sampleExcel.xlsx")
Set xlSheet = xlBook.Worksheets("Sheet1")
' ブックの全シートを 1 つずつループして処理する
Dim objSheet As Worksheet
For Each objSheet In xlBook.Worksheets
Debug.Print objSheet.Name & "を処理します"
'A1セルにシートの名前を書き込む
objSheet.Cells(1, 1) = "このシートの名前は" & objSheet.Name & "です。"
'シートを印刷する。
objSheet.PrintOut
Next
' Set rs = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Private Sub dispExcelData(ByVal recievedFullPath As String)
Dim xlApp As Object 'Excelアプリ'
Dim xlBook As Object 'Excelブック'
Dim xlSheet As Object 'Excelシート'
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.Application.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open(recievedFullPath)
'Set xlSheet = xlBook.Worksheets("Sheet1")
' ブックの全シートを 1 つずつループして処理する
Dim objSheet As Object
Dim rng As Object
For Each objSheet In xlBook.Worksheets
objSheet.Activate
Debug.Print objSheet.Name & "を処理します*****************"
Set rng = objSheet.range("A1:B6")
Dim vnt As Variant
vnt = rng.Value
Dim msg As String
Dim x As Integer
Dim i As Long
msg = ""
For x = 1 To UBound(vnt)
msg = msg & vnt(x, 1) & " " & vnt(x, 2) & vbCrLf
Next
MsgBox msg
Dim testString As String
testString = objSheet.range("B2").Value
MsgBox testString
testString = objSheet.range("B3").Value
MsgBox testString
testString = objSheet.range("B4").Value
MsgBox testString
testString = objSheet.range("B5").Value
MsgBox testString
objSheet.range("B2").Value = "cccc"
objSheet.range("B2").interior.colorindex = 4
objSheet.range("A6").ShrinkToFit = True
Debug.Print objSheet.Name & "を処理終了*****************"
Next objSheet
'xlApp.Quit
xlBook.Save
xlApp.Application.DisplayAlerts = True
xlBook.Close
xlApp.Quit
' Set xlSheet = Nothing
' Set xlBook = Nothing
' Set xlApp = Nothing
End Sub
コメント