accessファイルの abc.mdbのtable1のフィールド1のIDの数値を
現在開いているエクセルファイル Q.xlsxの
A2セルに移行したいのですが
エクセルのVBAにおいて
Sub IDエクセルへ移行()
'
'Dim myCon As New ADODB.Connection
Dim myRecordSet As New ADODB.Recordset
Dim mySQL As String
Dim dbFile As Variant
Dim mySheetName As Variant
Dim i As Integer
dbFile = "C:\Users\USER\Desktop\ABC\abc.mdb"
myCon.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbFile & ""
myCon.Open
mySQL = "SELECT * FROM table1"
myRecordSet.Open mySQL, myCon, adOpenDynamic
mySheetName = ActiveSheet.Name
With Worksheets(mySheetName)
.Cells(1, 2).Value = myRecordSet!ID
End With
myRecordSet.Close
Set myRecordSet = Nothing
myCon.Close
Set myCon = Nothing
'
'
ActiveWorkbook.Save
End Sub
-------------
上記を実行すると
objectがありません
と
myCon.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbFile & ""
ここの部分が黄色くなってしまいます
ここが さっぱり意味不明です
すみません
宜しくお願い致します
Microsoft ActiveX Data Objects 2.8 Library 6.1も
参照設定で チェックを入れました
win10 office365
office365
２つのオートシェープをグルーピングして図形を動作させたい
下記で
kibanは平行四辺形のオートシェープ
yajirushiは右向き矢印のオートシェープ
で、それぞれ、ある範囲で左から右に移動を繰り返します。
この２つのオートシェープをグルーピングして
平行四辺形の右側に矢印を配置した状態で、そのグルーピングされた図形の動作を繰り返す様にしたいのですが、
その内容が分からないのでコードで教えていただきたく、よろしくお願いします。
#If Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Sub kiban()
shape_delete
Dim ws2 As Worksheet
Dim i As Integer
Set ws2 = Sheets("sheet1")
ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 354, 46, 20).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With
ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 458, 20, 20).Select
ws2.Shapes(ws2.Shapes.Count).name = "kiban"
For i = 0 To 30
If i = 30 Then
i = 0
End If
ws2.Shapes(1).Left = i * 3 + 365
ws2.Shapes(1).Top = 458
Sleep 100
DoEvents
Next i
ws2.Shapes("kiban").delete
End Sub
Sub yajirushi()
shape_delete
Dim ws As Worksheet
Dim i As Integer
Set ws = Sheets("sheet1")
ws.Shapes.AddShape msoShapeRightArrow, 2265, 458, 20, 20
ws.Shapes(ws.Shapes.Count).name = "yajirushi"
For i = 0 To 30
If i = 30 Then
i = 0
End If
ws.Shapes(1).Left = i * 3 + 420
ws.Shapes(1).Top = 458
Sleep 100
DoEvents
Next i
ws.Shapes("yajirushi").delete
End Sub
Sub shape_delete()
Dim shp As Shape
Dim rng As Range
Range("P22:CM28").Select
If TypeName(Selection) <> "Range" Then Exit Sub
For Each shp In ActiveSheet.Shapes
'‘ 図形の配置されているセル範囲をオブジェクト変数にセット
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
'‘ 図形の配置されているセル範囲と
'‘ 選択されているセル範囲が重なっているときに図形を削除
If Not (Intersect(rng, Selection) Is Nothing) Then
shp.delete
End If
Next
End Sub
複数のテキストファイルを各シート毎にエクセルマクロを用いて貼りつけたいです。
【テキストの内容】
AAA BBB CCC DDD・・・
EEE FFF GGG HHH・・・
III JJJ KKK LLL・・・
・
・
・
上記のようなようなデータが書かれた複数のテキストファイルを各シート毎に張り付けるマクロを探していたところ
下記のようなものを見つけました。
しかし、
マクロを動かした所、一つのセルに一行分が入ってしまいます。
例)セルA1に
AAA BBB CCC DDDが貼り付けられてしまう
セルA2に
EEE FFF GGG HHHが貼り付けられてしまう
可能であればスペース区切りでセルA、セルB、セルCに分けたいです。
例)セルA1に
AAAが貼り付けられる
セルB1に
BBBが貼り付けられる
セルC2に
CCCが貼り付けられる
スペース区切りで張り付けらる方法をご教示ください。
===========================
Sub ReadTextFiles()
Const DirName = "C:\TEMP"
'上記で指定されたフォルダに存在するファイルで、
'拡張子がtxtのものをすべて１シートとして読み込む
Dim fs, dir, fc, f1, stream As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set dir = fs.GetFolder(DirName)
Set fc = dir.Files
For Each f1 In fc
If LCase(fs.GetExtensionName(f1.Name)) = "txt" Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Sheets(Worksheets.Count).Name = f1.Name
Set stream = f1.OpenAsTextStream
Do While stream.AtEndOfStream <> True
Cells(stream.Line, 1) = stream.ReadLine
Loop
stream.Close
End If
Next
End Sub
===========================
