エクセル2003使用です。
エクセルのセル範囲（"A1：J30"）の値をそのまま
IEのテキストエリア（textarea）に貼り付けたいのですが、
うまくできません。
貼り付けたいテキストエリアは下記のサイトです。
http://www.tagindex.com/tool/excel_simple.html
下記のコードは、変数に代入して張り付ける方法ですが、
この方法の他に、
・rangeプロパティーでコピー＆ペースト
・rangeプロパティーでコピー＆Sendkeys "^v"
（Webのテキストエリアをフォカース済み）
の方法で試しても上手くいきませんでした。
どの方法でも結構なのですが、
できましたら勉強のために、
（可能ならば）セル範囲の値を文字型変数に代入できる方法で
教えてもらえると幸いです。
---------
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetTickCount Lib "kernel32" () As Long
Sub sakusei_tbl_ikkatu()
'A1:J30に値を入力
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngNum As Long
Dim varCell As Variant
lngNum = 1
Sheets("sheet1").Activate
varCell = Sheets("sheet1").Range("A1:J30")
For i = 1 To 30
For j = 1 To 10
varCell(i, j) = lngNum
lngNum = lngNum + 1
Next
Next
Range("A1:J30") = varCell
'---------IE起動
Dim wpfreeURL As String
Dim ie As Object
wpfreeURL = "http://www.tagindex.com/tool/excel_simple.html"
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate2 wpfreeURL
'Call waitNavi(ie) ←質問ではコメントアウトさせてもらいます
'---------Web画面に貼り付け
Dim doc_MyTable As Object
Set doc_MyTable = ie.document.getElementsByTagName("textarea")
For Each doc_MyTable In ie.document.all.tags("textarea")
If Trim(doc_MyTable.Name) = "data" Then
doc_MyTable.Value = varCell
Exit For
End If
Next
End Sub
よろしくお願いします
64bit版ExcelのVBAでEnumChildWindowsを使用して、子ウィンドウのウィンドウハンドルを
取得したいと考えています。
下記のようなサンプルを作ってみましたが、コールバック関数でExcelが異常終了します。
（05行目にブレークポイントを設定、各変数の値を参照しようとした時点でExcelが異常終了)
また、コールバック関数の第3引数(lParam)の型をInteger,Long,LongPtr等変えてみましたが、
いずれもExcelの異常終了となりました。
つきまして、64bit Excelでの本ＡＰＩの使い方を教えていただきたくよろしくお願いいたします。
（なお、32bit版のExcelでは正常に動作しました)
<以下サンプルコード>
行 コード
01 Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal ParenthWnd as LongPtr, ByVal EnumWindosPROC as LongPtr,ByVal lParam as Long) as Integer
02
03
04 Function ListupChildWindows(hWnd as LongPtr,lParam as Long) as Boolean
05 MsgBox hWnd
06 ListupChildWIndows =True
07 End Function
08
09 Sub test_CwinList
10 Dim ThishWnd as LongPtr
11
12 ThishWnd=Excel.Application.hWnd
13 Call EnumChildWindows (ThishWnd , AddressOf ListupChildWindows ,0)
14 End Sub
Ａ：3に出勤数が表示されます。
出勤がある場合ｄ：3にハイパーリンクがあるので、リンク先の2ページめを印刷同じ
作業を下の段にのも繰り返す。
うまく動いていたのですが、新しくＰＣに移した当たりから 動かなくなりました。
厳密には 二人まではプリントするのですが、下の段までいかないみたいです。？
この様なメッセージが ↓
実行エラー9 インデックスが有効範囲にありません
下のマクロの どの部分を書き換えれば動きますか？
Sub 請求明細自動印刷()
Application.ScreenUpdating = False
Dim I As Integer
Dim リンクシート As String
For I = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(I, "A") <> 0 Then
リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
Sheets(リンクシート).PrintOut From:=2, To:=2
End If
Next I
End Sub
VBAで新規にエクセルのアプリケーションを起動し、
その中に既存のファイルを起動する方法は有りますか？
Sub Sample()
Dim appExcel As Excel.Application
Dim WSH As Variant
Dim strPath As String
Set appExcel = New Excel.Application
Set WSH = CreateObject("Wscript.Shell")
strPath = ActiveWorkbook.Path
With appExcel
.Visible = True
.Workbooks.Add
.ActiveWorkbook.SaveAs (strPath & "\ test.xls")
End With
Set WSH = Nothing
End Sub
このコードは、ネットから拾ったサンプルコードなのですが
新しいアプリケーションでエクセルを立ち上げることはできたのですが
新規のブックが開いてしまい、
更に、開きたいファイルに上書き保存してしまいそうです。
新規のブックが開く原因は
.Workbooks.Addで、
上書き保存する原因は
.ActiveWorkbook.SaveAs
だとわかってるのですが、
この部分を同変更すればいいのかがわかりません。
Workbooks.Open?Filename:="C:\Users\test.xlsx"
だと、現在実行しているvbaファイルを同じ枠内で
該当のファイルが開いてしまいます。
Ａ：3に出勤数が表示されます。
出勤がある場合ｄ：3にハイパーリンクがあるので、リンク先の2ページめを印刷同じ
作業を下の段にのも繰り返す。
うまく動いていたのですが、新しくＰＣに移した当たりから 動かなくなりました。
厳密には 二人まではプリントするのですが、下の段までいかないみたいです。？
この様なメッセージが ↓
実行エラー9 インデックスが有効範囲にありません
下のマクロの どの部分を書き換えれば動きますか？
Sub 請求明細自動印刷()
Application.ScreenUpdating = False
Dim I As Integer
Dim リンクシート As String
For I = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(I, "A") <> 0 Then
リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
Sheets(リンクシート).PrintOut From:=2, To:=2
End If
Next I
End Sub
エクセル2013です。
マクロの途中で列を削除するようにしてあります。
A列～J列、N列～Q列、T列～U列、W列～Y列を一括削除なのですが
A列～J列だけは、作業者が選択した1列だけを残して削除をしたいです。
マウスで選択させて、列を指定する所までは作成できましたが
列削除の部分（★の部分）が
思うように作成できず完成できません。
アドバイスをお願いいたします。
Sub 列削除()
Dim マウス選択
Dim 選択列
Dim 選択月表示
Dim 質問
On Error GoTo myError 'INPUT-BOXでキャンセルを選択した時の回避
Set マウス選択 = Application.InputBox("回覧用に編集したい月の列を選択してください", Type:=8)
If マウス選択.Columns.Count > 1 Then '選択したしたのが列で有り1列であるか確認
MsgBox "選択したのは列ではありません。又は2列以上を選択しています"
MsgBox "プログラムを中断します"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Exit Sub 'プログラム停止
End If
If マウス選択.Rows.Count > 1 Then '選択したのが行又はセルの場合の処理
Else
MsgBox "行又はセルを選択しています。1列を選択してください"
MsgBox "プログラムを中断します"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Exit Sub 'プログラム停止
End If
Set マウス選択 = マウス選択.EntireColumn
Debug.Print マウス選択.Address
選択列 = マウス選択.Column 'INPUT-BOXで選択した列を数字に置き換える
選択月表示 = Cells(2, 選択列).Value '選択した列の8行目のセルの値を格納
If 選択列 > 10 Then '選択したのが11列以上の場合の処理
MsgBox "11列目以降は選択できません"
MsgBox "プログラムを中断します"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Exit Sub 'プログラム停止
End If
質問 = MsgBox("選択した月は " & 選択月表示 & " です。いいですか？", vbYesNo)
If 質問 = vbYes Then
MsgBox "処理を行います"
'不要列削除
★ Union(Columns("A:J"),Columns("N:Q"), Columns("T:U"), Columns("W:Y")).Delete
Else
MsgBox "プログラムを中断します"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Exit Sub 'プログラム停止
End If
Exit Sub 'エラーが出なかった時のmyErrorの回避用
myError: 'INPUT-BOXでキャンセルを押した時の処理
MsgBox "キャンセルが押されました。プログラム終了します。"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Exit Sub
End Sub
こんにちは。
Excel2013を使用しています。
カタカナは全角、英数記号は半角で表示を統一したく、ネットで検索したサンプルコードを範囲や条件等を変更して下記コードを作成しました。
(サンプルコードが記載されていたページに簡易な例で全ての場合に対応できていないとの但し書きがありました。)
下記コードを実行すると、記号のうち、括弧、中点については半角表示になりますが、＃については全角表示のままです。
Mid(rData, i, 1) Like "＃" の Like を = に変更して、Mid(rData, i, 1) = "＃" とすると、＃についても半角表示になりました。
“全ての場合に対応できていない”に該当するものなのかもしれませんが、Like では希望する結果を得られない理由は何なのか気になり、質問させていただきました。
よろしくお願いします。
--------------------------------------------------
Sub test()
Dim c As Range
Dim i As Integer
Dim rData As Variant, ansData As Variant
For Each c In Range(Cells(3, "D"), Cells(Cells(Rows.Count, "D").End(xlUp).Row, "D"))
ansData = ""
For i = 1 To Len(c.Value)
rData = StrConv(c.Value, vbWide)
If Mid(rData, i, 1) Like "[Ａ-ｚ]" Or Mid(rData, i, 1) Like "[０-９]" _
Or Mid(rData, i, 1) Like "（" Or Mid(rData, i, 1) Like "）" _
Or Mid(rData, i, 1) Like "・" Or Mid(rData, i, 1) Like "＃" Then
ansData = ansData & StrConv(Mid(rData, i, 1), vbNarrow)
Else
ansData = ansData & Mid(rData, i, 1)
End If
Next i
c.Value = ansData
Next c
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
ActiveSheet.Protect UserInterfaceOnly:=True
Set R = Union(Range("D5:D38"), Range("E5:E38"), Range("T5:T38"))
With Target
If Intersect(.Cells, R) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range(Cells(.Row, .Column), Cells(38, .Column)).Value = .Value
Application.EnableEvents = True
End With
End Sub
この様なコードがあるのですが範囲を変更したいと思います。
D５：D38は上記コードのままで良いのですが、E5；E38はE5：E36に、T5：T38はT5：T36に変更するにはどうすれば良いのでしょうか？
